From 8f08a9ee5c6ff2974439cf935453cd02889f81e4 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 18 Sep 2020 13:52:02 -0600 Subject: [PATCH] cs: fix srcloc path conversion on load with no current-load-relative-directory Fall back to `current-directory` when `current-load-relative-directory` is #f. This change also affects `deserialize` --- not because byte code loading uses it directly in this case, but because they share a helper function, which exposes the issue. This implementation change is worrying (even though it makes the implementation match the documentation), but unless we discover that some use of serialization needs absolute paths deseialized as relative, is seems better to be consistent everywhere about falling back to `currenrt-directory`. This aspect of the change can be reverted separately (by adding more code) if needed. Closes racket/drracket#421 --- pkgs/racket-doc/scribblings/reference/printer.scrbl | 10 +++++----- pkgs/racket-test-core/tests/racket/serialize.rktl | 2 +- racket/collects/racket/private/relative-path.rkt | 3 ++- racket/src/cs/schemified/schemify.scm | 4 +++- 4 files changed, 11 insertions(+), 8 deletions(-) diff --git a/pkgs/racket-doc/scribblings/reference/printer.scrbl b/pkgs/racket-doc/scribblings/reference/printer.scrbl index 847e4044b4..3f4ef2be72 100644 --- a/pkgs/racket-doc/scribblings/reference/printer.scrbl +++ b/pkgs/racket-doc/scribblings/reference/printer.scrbl @@ -593,14 +593,14 @@ not normally printed in a way that can be read back in, path literals can be written and read as part of compiled code. The @racket[current-write-relative-directory] parameter is used to convert the path to a relative path as is it written, and then -@racket[current-load-relative-directory] parameter is used to convert -any relative path back as it is read. The relative-path conversion -applies on reading whether the path was originally relative or not. +@racket[current-load-relative-directory] parameter (falling back to +@racket[current-directory]) is used to convert +any relative path back as it is read. For a path in a syntax object's source, if the -@racket[current-load-relative-directory] parameter is not set of the +@racket[current-write-relative-directory] parameter is not set or the path is not relative to the value of the -@racket[current-load-relative-directory] parameter, then the path is +@racket[current-write-relative-directory] parameter, then the path is coerced to a string that preserves only part of the path (an in effort to make it less tied to the build-time filesystem, which can be different than the run-time filesystem). diff --git a/pkgs/racket-test-core/tests/racket/serialize.rktl b/pkgs/racket-test-core/tests/racket/serialize.rktl index e6f2a1b298..4b1025ee06 100644 --- a/pkgs/racket-test-core/tests/racket/serialize.rktl +++ b/pkgs/racket-test-core/tests/racket/serialize.rktl @@ -717,7 +717,7 @@ (deserialize (serialize root #:relative-directory (build-path root "a")))) (test - (build-path 'same) + (build-path (current-directory) 'same) 'this-dir-path (parameterize ([current-load-relative-directory #f]) (deserialize (serialize (build-path root 'same) #:relative-directory root))))) diff --git a/racket/collects/racket/private/relative-path.rkt b/racket/collects/racket/private/relative-path.rkt index 7b38259b89..f5738a27fe 100644 --- a/racket/collects/racket/private/relative-path.rkt +++ b/racket/collects/racket/private/relative-path.rkt @@ -4,7 +4,8 @@ make-path->relative-path-elements) (define (relative-path-elements->path elems) - (define wrt-dir (current-load-relative-directory)) + (define wrt-dir (or (current-load-relative-directory) + (current-directory))) (define rel-elems (for/list ([p (in-list elems)]) (if (bytes? p) (bytes->path-element p) p))) (cond diff --git a/racket/src/cs/schemified/schemify.scm b/racket/src/cs/schemified/schemify.scm index d91a21716e..0a5874610c 100644 --- a/racket/src/cs/schemified/schemify.scm +++ b/racket/src/cs/schemified/schemify.scm @@ -48042,7 +48042,9 @@ (lambda (e_0) (xify_0 e_0 hash2610)))) (define relative-path-elements->path (lambda (elems_0) - (let ((wrt-dir_0 (current-load-relative-directory))) + (let ((wrt-dir_0 + (let ((or-part_0 (current-load-relative-directory))) + (if or-part_0 or-part_0 (current-directory))))) (let ((rel-elems_0 (reverse$1 (begin