From 5c909cca0ddccb9c79d2a08a5764a7d48e4714d7 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 30 Apr 2014 14:36:33 -0600 Subject: [PATCH] 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. --- .../tests/compiler/embed/embed-me1f.rkt | 12 ++++++++ .../tests/compiler/embed/embed-me1f1.rktl | 1 + .../tests/compiler/embed/sub/embed-me1f2.rktl | 1 + .../tests/compiler/embed/test.rkt | 1 + .../scribblings/reference/filesystem.scrbl | 7 +++-- racket/collects/compiler/distribute.rkt | 28 +++++++++++++++---- 6 files changed, 43 insertions(+), 7 deletions(-) create mode 100644 pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/embed-me1f.rkt create mode 100644 pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/embed-me1f1.rktl create mode 100644 pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/sub/embed-me1f2.rktl diff --git a/pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/embed-me1f.rkt b/pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/embed-me1f.rkt new file mode 100644 index 0000000000..124a44cb48 --- /dev/null +++ b/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) diff --git a/pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/embed-me1f1.rktl b/pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/embed-me1f1.rktl new file mode 100644 index 0000000000..5e2940e678 --- /dev/null +++ b/pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/embed-me1f1.rktl @@ -0,0 +1 @@ +(load-relative "sub/embed-me1f2.rktl") diff --git a/pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/sub/embed-me1f2.rktl b/pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/sub/embed-me1f2.rktl new file mode 100644 index 0000000000..a70455650f --- /dev/null +++ b/pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/sub/embed-me1f2.rktl @@ -0,0 +1 @@ +(printf "This is 1f\n") diff --git a/pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/test.rkt b/pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/test.rkt index 0d13194071..e2609d1f6a 100644 --- a/pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/test.rkt +++ b/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) diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/reference/filesystem.scrbl b/pkgs/racket-pkgs/racket-doc/scribblings/reference/filesystem.scrbl index e9cc71ab11..20fc814b1c 100644 --- a/pkgs/racket-pkgs/racket-doc/scribblings/reference/filesystem.scrbl +++ b/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 -@racket[expr] produces a relative or absolute path, then the path +creator preserves the relative locations of all paths within a given +@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[ diff --git a/racket/collects/compiler/distribute.rkt b/racket/collects/compiler/distribute.rkt index c451348d02..bfad737437 100644 --- a/racket/collects/compiler/distribute.rkt +++ b/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 - (cons name (loop base)) - (list (root->path-element name)))))))] + (cond + [(path? base) + (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))]