diff --git a/pkgs/racket-test-core/tests/racket/fasl.rktl b/pkgs/racket-test-core/tests/racket/fasl.rktl
index 84ebbfef76..a39239d331 100644
--- a/pkgs/racket-test-core/tests/racket/fasl.rktl
+++ b/pkgs/racket-test-core/tests/racket/fasl.rktl
@@ -145,4 +145,18 @@
 (test (srcloc ".../a/.." 1 2 3 4) fasl->s-exp (s-exp->fasl (srcloc (build-path "a" 'up) 1 2 3 4)))
 (test (srcloc ".../a/." 1 2 3 4) fasl->s-exp (s-exp->fasl (srcloc (build-path "a" 'same) 1 2 3 4)))
 
+(let ([root (car (filesystem-root-list))])
+  (test
+   root
+   'longer-relative
+   (parameterize ([current-write-relative-directory (build-path root "a")])
+     (fasl->s-exp (s-exp->fasl root))))
+
+  (test
+   (build-path 'same)
+   'this-dir-path
+   (parameterize ([current-write-relative-directory root]
+                  [current-load-relative-directory #f])
+     (fasl->s-exp (s-exp->fasl (build-path root 'same))))))
+
 (report-errs)
diff --git a/pkgs/racket-test-core/tests/racket/serialize.rktl b/pkgs/racket-test-core/tests/racket/serialize.rktl
index 26e55a06b8..f9a22135c0 100644
--- a/pkgs/racket-test-core/tests/racket/serialize.rktl
+++ b/pkgs/racket-test-core/tests/racket/serialize.rktl
@@ -710,4 +710,40 @@
 
 ;; ----------------------------------------
 
+(let ([root (car (filesystem-root-list))])
+  (test
+   root
+   'longer-relative
+   (deserialize (serialize root #:relative-directory (build-path root "a"))))
+
+  (test
+   (build-path 'same)
+   'this-dir-path
+   (parameterize ([current-load-relative-directory #f])
+     (deserialize (serialize (build-path root 'same) #:relative-directory root)))))
+
+;; ----------------------------------------
+
+(let ()
+  (define (test-relative data rel)
+    (test
+     'right-error
+     'non-base-dir
+     (with-handlers ([exn:fail:contract?
+                      (λ (e)
+                        (if (string-prefix?
+                             (exn-message e)
+                             (string-append "serialize: relative-directory pair's first"
+                                            " path does not extend second path"))
+                            'right-error
+                            'wrong-error))])
+       (serialize data
+                  #:relative-directory rel))))
+
+   (test-relative (string->path "/x") (cons "/x" "/x/y"))
+
+   (test-relative (string->path "/x") (cons "/x/z" "/x/y")))
+
+;; ----------------------------------------
+
 (report-errs)
diff --git a/racket/collects/racket/private/relative-path.rkt b/racket/collects/racket/private/relative-path.rkt
index 593747bce3..7b38259b89 100644
--- a/racket/collects/racket/private/relative-path.rkt
+++ b/racket/collects/racket/private/relative-path.rkt
@@ -36,23 +36,38 @@
        (when (and (eq? exploded-base-dir 'not-ready)
                   (path? v))
          (define wrt-dir (and wr-dir (if (pair? wr-dir) (car wr-dir) wr-dir)))
+         (define exploded-wrt-dir (explode-path wrt-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)))))
+               (cond
+                 [(eq? base-dir wrt-dir) '()]
+                 [else
+                  (define exploded-wrt-dir (explode-path wrt-dir))
+                  (define base-len (length exploded-base-dir))
+                  (when who
+                    (unless (and 
+                             ((length exploded-wrt-dir) . >= . base-len)
+                             (for/and ([a (in-list exploded-wrt-dir)]
+                                       [b (in-list exploded-base-dir)])
+                               (equal? a b)))
+                      (raise-arguments-error who
+                                             "relative-directory pair's first path does not extend second path"
+                                             "first path" wrt-dir
+                                             "second path" base-dir)))
+                  (list-tail exploded-wrt-dir base-len)])))
        (and exploded-base-dir
             (path? v)
             (let ([exploded (explode-path v)])
               (and (for/and ([base-p (in-list exploded-base-dir)]
                              [p (in-list exploded)])
                      (equal? base-p p))
+                   ((length exploded) . >= . (length exploded-base-dir))
                    (let loop ([exploded-wrt-rel-dir exploded-wrt-rel-dir]
                               [rel (list-tail exploded (length exploded-base-dir))])
                      (cond
-                       [(null? exploded-wrt-rel-dir) (map path-element->bytes rel)]
+                       [(null? exploded-wrt-rel-dir) (for/list ([p (in-list rel)])
+                                                       (if (path? p) (path-element->bytes p) p))]
                        [(and (pair? rel)
                              (equal? (car rel) (car exploded-wrt-rel-dir)))
                         (loop (cdr exploded-wrt-rel-dir) (cdr rel))]