raco dist: preserve relative location of runtime files only within a package

Previously, relative locations were preserved for all files with the same
root, but that tends to keep too much information about the original
filesystem layout, especially when runtime files are pulled both from
the installation and a user-specific area. Since packages can be installed
at different relative locations, it makes sense to preserve relative
locations only up to package boundaries.

pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/embed-me1f.rkt

@@ -0,0 +1,12 @@
+#lang scheme/base
+
+(require scheme/runtime-path)
+
+;; Check that relative paths are preserved:
+(define-runtime-path f1 "embed-me1f1.rktl")
+(define-runtime-path f2 "sub/embed-me1f2.rktl")
+
+(with-output-to-file "stdout"
+  (lambda () (parameterize ([current-namespace (make-base-namespace)])
+               (load f1)))
+  #:exists 'append)

pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/embed-me1f1.rktl

@@ -0,0 +1 @@
+(load-relative "sub/embed-me1f2.rktl")

pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/sub/embed-me1f2.rktl

@@ -0,0 +1 @@
+(printf "This is 1f\n")

pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/test.rkt

@@ -236,6 +236,7 @@
     (one-mz-test "embed-me1c.rkt" "This is 1c\n" #f)
     (one-mz-test "embed-me1d.rkt" "This is 1d\n" #f)
     (one-mz-test "embed-me1e.rkt" "This is 1e\n" #f)
+    (one-mz-test "embed-me1f.rkt" "This is 1f\n" #f)
     (one-mz-test "embed-me2.rkt" "This is 1\nThis is 2: #t\n" #t)
     (one-mz-test "embed-me13.rkt" "This is 14\n" #f)
     (one-mz-test "embed-me14.rkt" "This is 14\n" #f)

pkgs/racket-pkgs/racket-doc/scribblings/reference/filesystem.scrbl

@@ -599,8 +599,9 @@ tools like the executable creator can also arrange (by colluding with
 substituted in a generated executable. If @racket[expr] produces an
 absolute path, it is normally returned directly, but again may be
 replaced by an executable creator. In all cases, the executable
-creator preserves the relative locations of all paths.  When
+creator preserves the relative locations of all paths within a given
-@racket[expr] produces a relative or absolute path, then the path
+@tech{package} (treating paths outside of any package as being together).
+When @racket[expr] produces a relative or absolute path, then the path
 bound to @racket[id] is always an absolute path.
 
 If @racket[expr] produces a list of the form @racket[(list 'lib _str
@@ -692,6 +693,8 @@ In the latter two cases, the path is normally preserved in
 result of @racket[collection-file-path], then the path is record as
 relative to the corresponding module path.
 
+@history[#:changed "6.0.1.6" @elem{Preserve relative paths only within a package.}]
+
 Examples:
 
 @racketblock[

racket/collects/compiler/distribute.rkt

@@ -4,6 +4,8 @@
            setup/dirs
            racket/list
            setup/variant
+           pkg/path
+           setup/main-collects
            dynext/filename-version
            "private/macfw.rkt"
            "private/windlldir.rkt"
@@ -472,6 +474,7 @@
   (define (copy-runtime-files-and-patch-binaries orig-binaries binaries types sub-dirs 
                                                  exts-dir relative-exts-dir
                                                  relative->binary-relative)
+    (define pkg-path-cache (make-hash))
     (let ([paths null])
       ;; Pass 1: collect all the paths
       (copy-and-patch-binaries #f #rx#"rUnTiMe-paths[)]"
@@ -492,7 +495,7 @@
                                exts-dir relative-exts-dir
                                relative->binary-relative)
       (unless (null? paths)
-        ;; Determine the shared path prefix:
+        ;; Determine the shared path prefix among paths within a package:
         (let* ([root-table (make-hash)]
                [root->path-element (lambda (root)
                                      (hash-ref root-table
@@ -502,12 +505,27 @@
                                                    (hash-set! root-table root v)
                                                    v))))]
                [explode (lambda (src)
+                          (define-values (pkg subpath)
+                            (path->pkg+subpath src #:cache pkg-path-cache))
+                          (define main
+                            (and (not pkg)
+                                 (path->main-collects-relative src)))
                           (reverse
-                           (let loop ([src src])
+                           (let loop ([src (cond
+                                            [pkg subpath]
+                                            [(pair? main)
+                                             (apply build-path
+                                                    (map bytes->path-element (cdr main)))]
+                                            [else src])])
                              (let-values ([(base name dir?) (split-path src)])
-                               (if base
+                               (cond
-                                   (cons name (loop base))
+                                [(path? base)
-                                   (list (root->path-element name)))))))]
+                                 (cons name (loop base))]
+                                [else
+                                 (list (root->path-element (or pkg
+                                                               (and (pair? main)
+                                                                    'collects)
+                                                               name)))])))))]
                ;; In reverse order, so we can pick off the paths
                ;;  in the second pass:
                [exploded (reverse (map explode paths))]