fix raco pkg conflict checking

When a module is currently installed as bytecode, but without
corresponding source and without a "info.rkt" specification that
bytecode should be preserved without source, then `raco pkg` should
not count that module bytecode as a conflict (since `raco setup`
will remove it).

pkgs/racket-test/tests/pkg/tests-conflicts.rkt

@@ -23,7 +23,7 @@
   (shelly-install "only modules are considered for conflicts"
                   "test-pkgs/pkg-test1.plt"
                   $ "raco pkg install test-pkgs/pkg-test1-not-conflict.plt")
-
+  
   (shelly-case
    "conflicts"
    (shelly-install "double install fails" "test-pkgs/pkg-test1.zip"
@@ -165,4 +165,73 @@
                (path-only (collection-file-path "test.rkt" "tests/pkg"))
                "racket-test"))
          "'")
-   =stdout> "'()\n")))
+   =stdout> "'()\n")
+  
+  (with-fake-root
+      (shelly-case
+       "non-conflicts on .zo files that will be deletced by `raco setup`"
+
+       (define (copy+install-not-conflict)
+         (define t1nc-dir (make-temporary-file "~a-t1nc" 'directory))
+         (define src-dir "test-pkgs/pkg-test1-not-conflict/")
+         (for ([i (directory-list src-dir)])
+           (copy-directory/files (build-path src-dir i) (build-path t1nc-dir i)))
+         (shelly-begin
+          $ (~a "raco pkg install " t1nc-dir))
+         t1nc-dir)
+       (define (set-conflict-mode t1nc-dir mode)
+         (define (maybe-delete-file p) (when (file-exists? p) (delete-file p)))
+         (case mode
+           [(src)
+            (set-file (build-path t1nc-dir "data" "empty-set.rkt") "#lang racket/base 'empty")
+            (maybe-delete-file (build-path t1nc-dir "data" "compiled" "empty-set_rkt.zo"))
+            (maybe-delete-file (build-path t1nc-dir "data" "info.rkt"))]
+           [(both)
+            (set-file (build-path t1nc-dir "data" "empty-set.rkt") "#lang racket/base 'empty")
+            (set-file (build-path t1nc-dir "data" "compiled" "empty-set_rkt.zo") "not real...")
+            (set-file (build-path t1nc-dir "data" "info.rkt") "#lang info\n(define assume-virtual-sources #t)")]
+           [(zo-stays)
+            (set-file (build-path t1nc-dir "data" "compiled" "empty-set_rkt.zo") "not real...")
+            (maybe-delete-file (build-path t1nc-dir "data" "empty-set.rkt"))
+            (set-file (build-path t1nc-dir "data" "info.rkt") "#lang info\n(define assume-virtual-sources #t)")]
+           [(zo-goes)
+            (set-file (build-path t1nc-dir "data" "compiled" "empty-set_rkt.zo") "not real...")
+            (maybe-delete-file (build-path t1nc-dir "data" "empty-set.rkt"))
+            (maybe-delete-file (build-path t1nc-dir "data" "info.rkt"))]))
+       
+       (define (install-pkg1-fails)
+         (shelly-begin
+          $ "raco pkg install test-pkgs/pkg-test1.zip"
+          =exit> 1
+          =stderr> #rx"packages conflict.*data/empty-set"))
+       (define (install-pkg1-succeeds)
+         (shelly-begin
+          $ "raco pkg install test-pkgs/pkg-test1.zip"
+          $ "raco pkg remove pkg-test1"))
+       
+       (define t1-nc1-dir (copy+install-not-conflict))
+       (set-conflict-mode t1-nc1-dir 'src)
+       (install-pkg1-fails)
+
+       (set-conflict-mode t1-nc1-dir 'both)
+       (install-pkg1-fails)
+
+       (set-conflict-mode t1-nc1-dir 'zo-stays)
+       (install-pkg1-fails)
+       
+       (set-conflict-mode t1-nc1-dir 'zo-goes)
+       (install-pkg1-succeeds)
+       
+       (define t1-nc2-dir (copy+install-not-conflict))
+
+       (for* ([m1 '(src both zo-stays zo-goes)]
+              [m2 '(src both zo-stays zo-goes)])
+         (printf "trying ~s ~s\n" m1 m2)
+         (set-conflict-mode t1-nc1-dir m1)
+         (set-conflict-mode t1-nc2-dir m2)
+         (if (and (eq? m1 'zo-goes) (eq? m2 'zo-goes))
+             (install-pkg1-succeeds)
+             (install-pkg1-fails)))
+       
+       (delete-directory/files t1-nc1-dir)
+       (delete-directory/files t1-nc2-dir)))))

pkgs/racket-test/tests/pkg/tests-scope.rkt

@@ -49,10 +49,11 @@
     $ "raco pkg remove pkg-test1" =stdout> #rx"Inferred package scope: installation")
 
    (shelly-case
-    "conflict due to installations in different scopes: user-specific first"
+    "no conflict due to installations in different scopes: user-specific first"
     $ "raco pkg install -u --copy test-pkgs/pkg-test1"
     $ "racket -l pkg-test1"  =stdout> #rx"main loaded"
-    $ "raco pkg install -i --copy test-pkgs/pkg-test1" =exit> 1 =stderr> #rx"packages in different scopes conflict"
+    $ "raco pkg install -i --copy test-pkgs/pkg-test1"
+    $ "raco pkg remove -i --no-trash pkg-test1" =stdout> "Removing pkg-test1\n"
     $ "raco pkg remove --no-trash pkg-test1" =stdout> "Removing pkg-test1\n")
 
    (shelly-case
@@ -67,11 +68,10 @@
     $ "raco pkg remove pkg-test1" =stdout> #rx"Inferred package scope: installation")
 
    (shelly-case
-    "override conflist, user first"
+    "check usability of user first, then installation"
     $ "raco pkg install -u --copy test-pkgs/pkg-test1"
     $ "racket -l racket/base -l pkg-test1/number -e '(number)'"  =stdout> "1\n"
-    $ "raco pkg install -i --name pkg-test1 --copy test-pkgs/pkg-test1-v2" =exit> 1
-    $ "raco pkg install --force -i --name pkg-test1 --copy test-pkgs/pkg-test1-v2"
+    $ "raco pkg install -i --name pkg-test1 --copy test-pkgs/pkg-test1-v2"
     $ "racket -l racket/base -l pkg-test1/number -e '(number)'"  =stdout> "1\n"
     $ "raco pkg remove --no-trash pkg-test1" =stdout> "Removing pkg-test1\n"
     $ "racket -l racket/base -l pkg-test1/number -e '(number)'"  =stdout> "2\n"

racket/collects/pkg/private/check-will-exist.rkt

@@ -0,0 +1,70 @@
+#lang racket/base
+(require compiler/compilation-path
+         setup/collection-search
+         racket/list
+         racket/string
+         "get-info.rkt")
+
+(provide check-found-module-will-exist)
+
+;; Check whether the given path exists (as the resolved form of the
+;; given module path, which must be a normalized 'lib path).
+;; Make sure it will continue to exist after `raco setup` is run
+;; -- that is, that it's not a bytecode file without source so
+;; that the file will be deleted.
+;; If `f` refers to a bytecode file that will be deleted, look for
+;; another resolution of the module path that will stick around.
+(define (check-found-module-will-exist f mp metadata-ns)
+  (define v (check-one-found-module-will-exist f mp metadata-ns #:deleted-result 'going))
+  (cond
+   [(eq? v 'going) (find-module/slow-way mp metadata-ns)]
+   [else v]))
+
+;; Check one particular path, with capability to report that a
+;; byetcode file won't count because it should be deleted.
+(define (check-one-found-module-will-exist f mp metadata-ns
+                                           #:deleted-result [deleted-result #f])
+  (define v
+    (or (file-exists? f)
+        (file-exists? (path-replace-suffix f #".ss"))
+        (and (or (file-exists? (get-compilation-bytecode-file f))
+                 (file-exists? (get-compilation-bytecode-file (path-replace-suffix f #".ss"))))
+             ;; found bytecode; make sure it won't be deleted by `raco setup`
+             (or (bytecode-will-stick-around? f mp metadata-ns)
+                 deleted-result))))
+  (if (eq? v #t)
+      f
+      v))
+
+;; Given that a bytecode's source file was not around, check whether
+;; the bytecode will stick around as a result of an
+;; 'assume-virtual-sources in an "info.rkt" file.
+(define (bytecode-will-stick-around? f mp metadata-ns)
+  (unless (and (pair? mp)
+               (eq? 'lib (car mp))
+               (null? (cddr mp)))
+    (error 'bytecode-will-stick-around? "expected a normalized 'lib path"))
+  (define cols (drop-right (string-split (cadr mp) "/")
+                           1))
+  (define-values (dir name dir?) (split-path f))
+  (let loop ([cols cols] [dir dir])
+    (cond
+     [(null? cols) #f]
+     [else
+      (define info (get-pkg-info dir metadata-ns))
+      (or (and info
+               (info 'assume-virtual-sources (lambda () #f)))
+          (let-values ([(base name dir?) (split-path dir)])
+            (loop (cdr cols) base)))])))
+
+;; We tried a fast way to find a module as existing, but it
+;; didn't work, because the one will found will go away when
+;; `raco setup` is run, and so we don't want to count that
+;; one. Search manually. The given `mp` must be a normalized
+;; 'lib path.
+(define (find-module/slow-way mp metadata-ns)
+  (collection-search mp
+                     #:combine (lambda (r f)
+                                 (when r (log-error "oops ~s" r))
+                                 (check-one-found-module-will-exist f mp metadata-ns))
+                     #:break? (lambda (r) r)))

racket/collects/pkg/private/install.rkt

@@ -8,7 +8,6 @@
          racket/set
          racket/function
          openssl/sha1
-         compiler/compilation-path
          version/utils
          setup/link
          "../path.rkt"
@@ -31,7 +30,8 @@
          "clone-path.rkt"
          "orig-pkg.rkt"
          "info-to-desc.rkt"
-         "git.rkt")
+         "git.rkt"
+         "check-will-exist.rkt")
 
 (provide pkg-install
          pkg-update)
@@ -262,17 +262,18 @@
           (when f
             (unless (path? f)
               (pkg-error "expected a filesystem path for a resolved module path: ~a" mp)))
-          ;; Check for source or compiled:
+          (define found-f
+            (and f
+                 ;; Check for source or compiled; may need to use a slower process to
+                 ;; find the relevant one:
+                 (check-found-module-will-exist f mp metadata-ns)))
           (cond
-           [(and f
-                 (or (file-exists? f)
-                     (file-exists? (path-replace-suffix f #".ss"))
-                     (file-exists? (get-compilation-bytecode-file f))
-                     (file-exists? (get-compilation-bytecode-file (path-replace-suffix f #".ss"))))
-                 (or (not updating?)
-                     (not (hash-ref simultaneous-installs (path->pkg f #:cache path-pkg-cache) #f))))
+           [(and found-f
+                 ;; If it's from a simultaneous install, we'll want to check the updated
+                 ;; version of the package, instead:
+                 (not (hash-ref simultaneous-installs (path->pkg found-f #:cache path-pkg-cache) #f)))
             ;; This module is already installed
-            (cons (path->pkg f #:cache path-pkg-cache) mp)]
+            (cons (path->pkg found-f #:cache path-pkg-cache) mp)]
            [else
             ;; Compare with simultaneous installs
             (for/or ([other-pkg-info (in-list infos)]