racket/fasl: use current-directory for relative-path unmarshaling

Relative-path handling for `fasl->s-exp` was meant to be like code
unmarshaling, but it did not fall back to `(current-directory)` when
`(current-load-relative-directory)` is #f. There's some risk to
changing the behavior of `fasl->s-exp`, but better matching the intent
seems at least as likely to fix problems as create them. One problem
it fixes is in CS code marshaling.

Closes racket/drracket#421 (again)

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

@@ -62,7 +62,8 @@ structures. Compose @racket[s-exp->fasl] with @racket[serialize] to
 preserve graph structure, handle cyclic data, and encode serializable
 structures. The @racket[s-exp->fasl] and @racket[fasl->s-exp]
 functions consult @racket[current-write-relative-directory] and
-@racket[current-load-relative-directory], respectively, in the same
+@racket[current-load-relative-directory]
+(falling back to @racket[current-directory]), respectively, in the same
 way as bytecode saving and loading to store paths in relative form,
 and they similarly allow and convert constrained @racket[srcloc]
 values (see @secref["print-compiled"]).

pkgs/racket-test-core/tests/racket/fasl.rktl

@@ -154,15 +154,16 @@
 (let* ([file-p (build-path "data.rktd")]
        [dir-p (build-path "nested")]
        [rel-p (build-path dir-p file-p)]
-       [p (build-path (current-directory) rel-p)])
+       [p (build-path (current-directory) rel-p)]
+       [unnested-p (build-path (current-directory) file-p)])
   (define-values (bstr srcloc-bstr)
     (parameterize ([current-write-relative-directory (current-directory)])
       (values
        (s-exp->fasl p)
        (s-exp->fasl (srcloc p 10 20 30 40)))))
   (parameterize ([current-load-relative-directory #f])
-    (test rel-p fasl->s-exp bstr)
+    (test p fasl->s-exp bstr)
-    (test (srcloc rel-p 10 20 30 40) fasl->s-exp srcloc-bstr))
+    (test (srcloc p 10 20 30 40) fasl->s-exp srcloc-bstr))
   (parameterize ([current-load-relative-directory (current-directory)])
     (test p fasl->s-exp bstr)
     (test (srcloc p 10 20 30 40) fasl->s-exp srcloc-bstr))
@@ -179,10 +180,10 @@
          (s-exp->fasl alt-p)
          (s-exp->fasl (srcloc alt-p 10 20 30 40)))))
     (parameterize ([current-load-relative-directory #f])
-      (test file-p fasl->s-exp bstr)
+      (test unnested-p fasl->s-exp bstr)
-      (test (srcloc file-p 10 20 30 40) fasl->s-exp srcloc-bstr)
+      (test (srcloc unnested-p 10 20 30 40) fasl->s-exp srcloc-bstr)
-      (test (build-path 'up alt-rel-p) fasl->s-exp bstr2)
+      (test (build-path (current-directory) 'up alt-rel-p) fasl->s-exp bstr2)
-      (test (srcloc (build-path 'up alt-rel-p) 10 20 30 40) fasl->s-exp srcloc-bstr2))
+      (test (srcloc (build-path (current-directory) 'up alt-rel-p) 10 20 30 40) fasl->s-exp srcloc-bstr2))
     (parameterize ([current-load-relative-directory (build-path (current-directory) dir-p)])
       (test p fasl->s-exp bstr)
       (test (srcloc p 10 20 30 40) fasl->s-exp srcloc-bstr)
@@ -203,7 +204,7 @@
      (fasl->s-exp (s-exp->fasl root))))
 
   (test
-   (build-path 'same)
+   (build-path (current-directory) 'same)
    'this-dir-path
    (parameterize ([current-write-relative-directory root]
                   [current-load-relative-directory #f])

pkgs/racket-test-core/tests/racket/module.rktl

@@ -3537,6 +3537,47 @@ case of module-leve bindings; it doesn't cover local bindings.
     ;; will be 6 instead of 5:
     (test 5 dynamic-require ''uses-module-out-of-thin-air 'also-five)))
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Check relative-path encoding and decoding for procedure source locations
+
+(let ([m (compile `(module m racket/base
+                     (provide f)
+                     (define f ,(datum->syntax #f
+                                               `(lambda (thunk) (list (thunk)))
+                                               (list (build-path (current-directory) "the-file.rkt")
+                                                     2
+                                                     3
+                                                     4
+                                                     5)))))])
+  (define o (open-output-bytes))
+  (parameterize ([current-write-relative-directory (current-directory)])
+    (write m o))
+  (define (get)
+    (parameterize ([read-accept-compiled #t])
+      (read (open-input-bytes (get-output-bytes o)))))
+  (define (check-name m p)
+    (parameterize ([current-namespace (make-base-namespace)])
+      (eval m)
+      (define f (dynamic-require ''m 'f))
+      (define e (with-handlers ([exn:fail? values])
+                  (f (lambda () (car 0)))))
+      (define ctx (continuation-mark-set->context (exn-continuation-marks e)))
+      (test
+       #t
+       `(has ,p)
+       (for/or ([pr (in-list ctx)])
+         (printf ">> ~s\n" (cdr pr))
+         (and (cdr pr)
+              (equal? p (srcloc-source (cdr pr))))))))
+  (let ([m1 (parameterize ([current-load-relative-directory #f])
+              (get))])
+    (check-name m1 (build-path (current-directory) "the-file.rkt"))
+    (void))
+  (let ([m1 (parameterize ([current-load-relative-directory (find-system-path 'temp-dir)])
+              (get))])
+    (check-name m1 (build-path (find-system-path 'temp-dir) "the-file.rkt"))
+    (void)))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (report-errs)

racket/collects/racket/fasl.rkt

@@ -465,7 +465,8 @@
      [(fasl-path-type) (bytes->path (read-fasl-bytes i)
                                     (loop))]
      [(fasl-relative-path-type)
-      (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 (loop))])
                           (if (bytes? p) (bytes->path-element p) p)))
       (cond

racket/src/cs/schemified/expander.scm

@@ -23263,7 +23263,11 @@
                                              (if (unsafe-fx< index_0 26)
                                                (if (unsafe-fx< index_0 25)
                                                  (let ((wrt-dir_0
-                                                        (current-load-relative-directory)))
+                                                        (let ((or-part_0
+                                                               (current-load-relative-directory)))
+                                                          (if or-part_0
+                                                            or-part_0
+                                                            (current-directory)))))
                                                    (let ((rel-elems_0
                                                           (reverse$1
                                                            (let ((lst_0

racket/src/cs/schemified/schemify.scm

@@ -38816,7 +38816,11 @@
                                              (if (unsafe-fx< index_0 26)
                                                (if (unsafe-fx< index_0 25)
                                                  (let ((wrt-dir_0
-                                                        (current-load-relative-directory)))
+                                                        (let ((or-part_0
+                                                               (current-load-relative-directory)))
+                                                          (if or-part_0
+                                                            or-part_0
+                                                            (current-directory)))))
                                                    (let ((rel-elems_0
                                                           (reverse$1
                                                            (let ((lst_0