diff --git a/pkgs/racket-pkgs/racket-index/setup/scribble.rkt b/pkgs/racket-pkgs/racket-index/setup/scribble.rkt index f96ebed723..773ddc0324 100644 --- a/pkgs/racket-pkgs/racket-index/setup/scribble.rkt +++ b/pkgs/racket-pkgs/racket-index/setup/scribble.rkt @@ -210,7 +210,7 @@ (setup-printf "removing" "~a (documentation directory)" - (path->relative-string/setup p)) + (path->relative-string/setup/pkg p)) (delete-directory/files p))))) (define (can-build*? docs) (can-build? only-dirs docs)) @@ -423,7 +423,7 @@ (unless one? (setup-printf "WARNING" "undefined tag in ~a:" - (path->relative-string/setup + (path->relative-string/setup/pkg (doc-src-file (info-doc info)))) (set! one? #t)) (setup-printf #f " ~s" k)))]) @@ -497,7 +497,7 @@ (if workerid (format "~a " workerid) "") (if (info-rendered? i) "re-rendering" "rendering") ) "~a" - (path->relative-string/setup (doc-src-file (info-doc i))))) + (path->relative-string/setup/pkg (doc-src-file (info-doc i))))) (define (update-info info response) (match response [#f (set-info-failed?! info #t)] @@ -851,7 +851,7 @@ "running")] [else "skipping"])) "~a" - (path->relative-string/setup (doc-src-file doc)))) + (path->relative-string/setup/pkg (doc-src-file doc)))) (when force-out-of-date? (for ([p (in-list info-out-files)]) @@ -982,7 +982,7 @@ (if workerid (format "~a " workerid) "") (if move? "moving" "syncing")) "~a" - (path->relative-string/setup src-dir)) + (path->relative-string/setup/pkg src-dir)) (when move? (when (directory-exists? dest-dir) diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/setup.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/setup.rktl index cd0d8618de..6c3e40e51b 100644 --- a/pkgs/racket-pkgs/racket-test/tests/racket/setup.rktl +++ b/pkgs/racket-pkgs/racket-test/tests/racket/setup.rktl @@ -5,7 +5,7 @@ (require setup/path-to-relative) (let ([missing "/some/inexistent/path"] - [collects (build-path (collection-path "racket") "foo.rkt")] + [collects (build-path (path-only (collection-file-path "main.rkt" "racket")) "foo.rkt")] [relative "some/path"]) (define (test-both path/str expected-str [lib-expected expected-str]) (define str (if (string? path/str) path/str (path->string path/str))) diff --git a/racket/lib/collects/setup/path-to-relative.rkt b/racket/lib/collects/setup/path-to-relative.rkt index 20e3930ec7..eaa00029e7 100644 --- a/racket/lib/collects/setup/path-to-relative.rkt +++ b/racket/lib/collects/setup/path-to-relative.rkt @@ -7,7 +7,8 @@ (only-in planet/config [CACHE-DIR find-planet-dir])) (provide make-path->relative-string - path->relative-string/library) + path->relative-string/library + path->relative-string/setup) (define (make-path->relative-string dirs [default (lambda (x) (if (path? x) (path->string x) x))]) @@ -48,3 +49,9 @@ (list (cons find-collects-dir "/") (cons find-user-collects-dir "/") (cons find-planet-dir "/")))) + +(define path->relative-string/setup + (make-path->relative-string + (list (cons find-collects-dir "") + (cons find-user-collects-dir "/") + (cons find-planet-dir "/")))) diff --git a/racket/lib/collects/setup/private/setup-relative.rkt b/racket/lib/collects/setup/private/setup-relative.rkt index 0651dd882f..61ff9eebdf 100644 --- a/racket/lib/collects/setup/private/setup-relative.rkt +++ b/racket/lib/collects/setup/private/setup-relative.rkt @@ -5,9 +5,9 @@ "../dirs.rkt" "../path-to-relative.rkt") -(provide path->relative-string/setup) +(provide path->relative-string/setup/pkg) -(define path->relative-string/setup +(define path->relative-string/setup/pkg (make-path->relative-string (list (cons find-collects-dir "/") (cons find-user-collects-dir "/") diff --git a/racket/lib/collects/setup/setup-unit.rkt b/racket/lib/collects/setup/setup-unit.rkt index 41c21d685f..864b51c9f8 100644 --- a/racket/lib/collects/setup/setup-unit.rkt +++ b/racket/lib/collects/setup/setup-unit.rkt @@ -214,7 +214,7 @@ (error name-sym "'name' result from collection ~e is not a string: ~e" path x))))) - (define path-name (path->relative-string/setup path)) + (define path-name (path->relative-string/setup/pkg path)) (when (info 'compile-subcollections (lambda () #f)) (setup-printf "WARNING" "ignoring `compile-subcollections' entry in info ~a" @@ -635,7 +635,7 @@ (unless printed? (set! printed? #t) (setup-printf "deleting" "in ~a" - (path->relative-string/setup (cc-path cc))))) + (path->relative-string/setup/pkg (cc-path cc))))) (for ([path paths]) (define full-path (build-path (cc-path cc) path)) (when (or (file-exists? full-path) (directory-exists? full-path)) @@ -683,7 +683,7 @@ (define dep (build-path dir mode-dir (path-add-suffix name #".dep"))) (when (and (file-exists? dep) (file-exists? zo)) (set! did-something? #t) - (setup-printf "deleting" "~a" (path->relative-string/setup zo)) + (setup-printf "deleting" "~a" (path->relative-string/setup/pkg zo)) (delete-file/record-dependency zo dependencies) (delete-file/record-dependency dep dependencies)))) (when did-something? (loop dependencies))) @@ -832,7 +832,7 @@ (lambda (p where) (set! gcs 2) (setup-fprintf p #f " in ~a" - (path->relative-string/setup + (path->relative-string/setup/pkg (path->complete-path where (cc-path cc))))) (lambda () (define dir (cc-path cc)) @@ -1047,7 +1047,7 @@ (define-values [base name dir?] (split-path info-path)) (make-directory* base) (define p info-path) - (setup-printf "updating" "~a" (path->relative-string/setup p)) + (setup-printf "updating" "~a" (path->relative-string/setup/pkg p)) (when (verbose) (define ht0 (hash-ref ht-orig info-path)) (when ht0