From 7538011f5f1b713eb33dc58d7abda32db283a54d Mon Sep 17 00:00:00 2001
From: Spencer Florence <spencer@florence.io>
Date: Thu, 21 May 2020 13:48:02 -0500
Subject: [PATCH] Strip package-content-state from info files when stripping to
 source

---
 pkgs/racket-test/tests/pkg/tests-api.rkt | 14 +++++++
 racket/collects/pkg/strip.rkt            | 50 ++++++++++++------------
 2 files changed, 38 insertions(+), 26 deletions(-)

diff --git a/pkgs/racket-test/tests/pkg/tests-api.rkt b/pkgs/racket-test/tests/pkg/tests-api.rkt
index f19e73a5cf..19a6624331 100644
--- a/pkgs/racket-test/tests/pkg/tests-api.rkt
+++ b/pkgs/racket-test/tests/pkg/tests-api.rkt
@@ -2,6 +2,7 @@
 (require rackunit
          racket/file
          pkg/strip
+         setup/getinfo
          "util.rkt")
 
 (this-test-is-run-by-the-main-test)
@@ -12,7 +13,9 @@
    (define tmp-dir (path->directory-path (make-temporary-file "tmp~a" 'directory)))
    (define pkg-path (build-path "test-pkgs" "pkg-strip"))
    (define pkg-dest-path (build-path tmp-dir "pkg-strip"))
+   (define pkg-dest-path-for-built (build-path tmp-dir "pkg-strip-built"))
    (make-directory pkg-dest-path)
+   (make-directory pkg-dest-path-for-built)
 
    (define rx:does-not-exist #rx"directory does not exist")
 
@@ -49,4 +52,15 @@
    ;; Paths to existing src and dest directories should succeed.
    (check-not-exn (lambda () (generate-stripped-directory 'source pkg-path pkg-dest-path)))
 
+   ;; check that stripping from built to source correctly changes pkg type
+   (check-equal?
+    (begin
+      (generate-stripped-directory 'source pkg-path pkg-dest-path-for-built)
+      (generate-stripped-directory 'built pkg-dest-path-for-built pkg-dest-path-for-built)
+      (generate-stripped-directory 'source pkg-dest-path-for-built pkg-dest-path-for-built)            
+      ((get-info/full pkg-dest-path-for-built)
+       'package-content-state
+       (lambda () 'no-package-content-state)))
+    'no-package-content-state)
+
    ))
diff --git a/racket/collects/pkg/strip.rkt b/racket/collects/pkg/strip.rkt
index 6c8114cab6..d0fb442beb 100644
--- a/racket/collects/pkg/strip.rkt
+++ b/racket/collects/pkg/strip.rkt
@@ -181,28 +181,26 @@
       [else #f]))
   
   (define (fixup new-p path src-base level)
-    (case mode
-      [(binary binary-lib built)
-       (define bstr (path->bytes path))
-       (cond
-        [(regexp-match? #rx"[.]html$" bstr)
-         (fixup-html new-p)]
-        [else
-         (case mode
-           [(binary binary-lib)
+    (define bstr (path->bytes path))
+    (cond
+      [(and (not (eq? mode 'source)) (regexp-match? #rx"[.]html$" bstr))
+       (fixup-html new-p)]
+      [else
+       (case mode
+         [(binary binary-lib)
+          (cond
+            [(equal? #"info.rkt" bstr)
+             (fixup-info new-p src-base level mode)]
+            [(regexp-match? #rx"[.]zo$" bstr)
+             (fixup-zo new-p)])]
+         [(built source)
+          (when (or (eq? level 'package)
+                    (eq? level 'package+collection))
             (cond
-             [(equal? #"info.rkt" bstr)
-              (fixup-info new-p src-base level mode)]
-             [(regexp-match? #rx"[.]zo$" bstr)
-              (fixup-zo new-p)])]
-           [(built)
-            (when (or (eq? level 'package)
-                      (eq? level 'package+collection))
-              (cond
-               [(equal? #"info.rkt" bstr)
-                (fixup-info new-p src-base level mode)]
-               [else (void)]))]
-           [else (void)])])]))
+              [(equal? #"info.rkt" bstr)
+               (fixup-info new-p src-base level mode)]
+              [else (void)]))]
+         [else (void)])]))
   
   (define (explore base   ; containing directory relative to `dir`, 'base at start
                    paths  ; paths in `base'
@@ -269,9 +267,7 @@
        [else 'package]))) 
   
   (explore 'same (directory-list dir) drops keeps #f level)
-  (case mode
-    [(binary binary-lib built) (unmove-files dir dest-dir drop-keep-ns)]
-    [else (void)])
+  (unmove-files dir dest-dir drop-keep-ns)
   (case mode
     [(built binary binary-lib)
      (create-info-as-needed mode dest-dir level)]
@@ -373,7 +369,9 @@
               [(binary binary-lib)
                `((define assume-virtual-sources #t))]
               [else '()])
-          (define package-content-state '(,mode ,(version)))
+          ,@(case mode
+              [(source) '()]
+              [else `((define package-content-state '(,mode ,(version))))])
           . ,(filter values
                      (map (fixup-info-definition get-info mode) defns)))))
     (define new-content
@@ -403,7 +401,7 @@
     [`(define package-content-state . ,v) #f]
     [_
      (case mode
-       [(built) defn]
+       [(built source) defn]
        [else
         (match defn
           [`(define build-deps . ,v) #f]