diff --git a/pkgs/racket-test-core/tests/racket/fasl.rktl b/pkgs/racket-test-core/tests/racket/fasl.rktl
index f805c34ea6..84ebbfef76 100644
--- a/pkgs/racket-test-core/tests/racket/fasl.rktl
+++ b/pkgs/racket-test-core/tests/racket/fasl.rktl
@@ -101,7 +101,9 @@
       (test (srcloc (path->string (build-path root 'same)) 1 2 3 4) fasl->s-exp (s-exp->fasl (srcloc (build-path root 'same) 1 2 3 4))))
     (test (srcloc ".../a/b" 1 2 3 4) fasl->s-exp (s-exp->fasl (srcloc (build-path (current-directory) "a" "b") 1 2 3 4)))))
 
-(let* ([rel-p (build-path "nested" "data.rktd")]
+(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)])
   (define-values (bstr srcloc-bstr)
     (parameterize ([current-write-relative-directory (current-directory)])
@@ -113,7 +115,30 @@
     (test (srcloc rel-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)))
+    (test (srcloc p 10 20 30 40) fasl->s-exp srcloc-bstr))
+
+  ;; Try a pair for `current-write-relative-directory`
+  (let* ([alt-rel-p (build-path "alternate" "bytes.rktd")]
+         [alt-p (build-path (current-directory) alt-rel-p)])
+    (define-values (bstr srcloc-bstr bstr2 srcloc-bstr2)
+      (parameterize ([current-write-relative-directory (cons (build-path (current-directory) dir-p)
+                                                             (current-directory))])
+        (values
+         (s-exp->fasl p)
+         (s-exp->fasl (srcloc p 10 20 30 40))
+         (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 (srcloc file-p 10 20 30 40) fasl->s-exp srcloc-bstr)
+      (test (build-path '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))
+    (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)
+      (let ([up-alt-p (build-path (current-directory) dir-p 'up alt-rel-p)])
+        (test up-alt-p fasl->s-exp bstr2)
+        (test (srcloc up-alt-p 10 20 30 40) fasl->s-exp srcloc-bstr2)))))
 
 (test (srcloc ".../a" 1 2 3 4) fasl->s-exp (s-exp->fasl (srcloc (build-path 'up "a") 1 2 3 4)))
 (test (srcloc ".../a" 1 2 3 4) fasl->s-exp (s-exp->fasl (srcloc (build-path 'same "a") 1 2 3 4)))
diff --git a/racket/collects/racket/fasl.rkt b/racket/collects/racket/fasl.rkt
index 6d2978b481..81b3863058 100644
--- a/racket/collects/racket/fasl.rkt
+++ b/racket/collects/racket/fasl.rkt
@@ -126,19 +126,36 @@
       [(prefab-struct-key v)
        (loop (struct->vector v))]
       [else (void)]))
-  (define exploded-wrt-dir 'not-ready)
+  (define exploded-base-dir 'not-ready)
+  (define exploded-wrt-rel-dir 'not-ready)
   (define (path->relative-path-elements v)
-    (when (and (eq? exploded-wrt-dir 'not-ready)
+    (when (and (eq? exploded-base-dir 'not-ready)
                (path? v))
-      (define wrt-dir (current-write-relative-directory))
-      (set! exploded-wrt-dir (and wrt-dir (explode-path wrt-dir))))
-    (and exploded-wrt-dir
+      (define wr-dir (current-write-relative-directory))
+      (define wrt-dir (and wr-dir (if (pair? wr-dir) (car wr-dir) wr-dir)))
+      (define base-dir (and wr-dir (if (pair? wr-dir) (cdr wr-dir) wr-dir)))
+      (set! exploded-base-dir (and base-dir (explode-path base-dir)))
+      (set! exploded-wrt-rel-dir
+            (if (eq? base-dir wrt-dir)
+                '()
+                (list-tail (explode-path wrt-dir)
+                           (length exploded-base-dir)))))
+    (and exploded-base-dir
          (path? v)
          (let ([exploded (explode-path v)])
-           (and (for/and ([wrt-p (in-list exploded-wrt-dir)]
+           (and (for/and ([base-p (in-list exploded-base-dir)]
                           [p (in-list exploded)])
-                  (equal? wrt-p p))
-                (list-tail exploded (length exploded-wrt-dir))))))
+                  (equal? base-p p))
+                (let loop ([exploded-wrt-rel-dir exploded-wrt-rel-dir ]
+                           [rel (list-tail exploded (length exploded-base-dir))])
+                  (cond
+                    [(null? exploded-wrt-rel-dir) rel]
+                    [(and (pair? rel)
+                          (equal? (car rel) (car exploded-wrt-rel-dir)))
+                     (loop (cdr exploded-wrt-rel-dir) (cdr rel))]
+                    [else (append (for/list ([p (in-list exploded-wrt-rel-dir)])
+                                    'up)
+                                  rel)]))))))
   (define (treat-immutable? v) (or (not keep-mutable?) (immutable? v)))
   ;; The fasl formal prefix:
   (write-bytes fasl-prefix o)