From 91d059c8171cda5e6e51603281a58597fbea7929 Mon Sep 17 00:00:00 2001
From: Leif Andersen <leif@leifandersen.net>
Date: Mon, 16 Jul 2018 18:45:47 -0400
Subject: [PATCH] Relative paths should still be readable. (#2172)

* Relative paths should still be readable.

The resent PR to enable relative serialization resulted in serialzed
objects that weren't actually readable (containing literal path
elements). This PR converts them to bytes.

* Move from serialize to relative path.

Also change path->bytes to path-element->bytes

* Path elements can also be 'up and 'same.

Also merge in the relevant code from racket/fasl.
---
 .../tests/racket/serialize.rktl               | 19 ++++++++++++++++++-
 racket/collects/racket/fasl.rkt               |  3 +--
 .../collects/racket/private/relative-path.rkt |  5 +++--
 3 files changed, 22 insertions(+), 5 deletions(-)

diff --git a/pkgs/racket-test-core/tests/racket/serialize.rktl b/pkgs/racket-test-core/tests/racket/serialize.rktl
index 70d4c87ae9..ba9b700027 100644
--- a/pkgs/racket-test-core/tests/racket/serialize.rktl
+++ b/pkgs/racket-test-core/tests/racket/serialize.rktl
@@ -622,9 +622,14 @@
                                    "              #:" rel-mode "relative-directory"
                                    "              (find-system-path 'temp-dir))))\n"))))
       (define s (dynamic-require `(submod ,fn main) 's))
+      (define-values (in out) (make-pipe))
+      (write s out)
+      (close-output-port out)
+      (define read-s (read in))
       (define foo? (dynamic-require `(submod ,fn main) 'foo?))
       (parameterize ([current-load-relative-directory (find-system-path 'temp-dir)])
-        (test #t 'relative-dir (foo? (deserialize s))))
+        (test #t 'relative-dir (foo? (deserialize s)))
+        (test #t 'relative-dir (foo? (deserialize read-s))))
       (test (if fail-rel? 'correct-error 'worked)
             'unrelative-dir
             (with-handlers ([exn:fail:contract?
@@ -645,6 +650,18 @@
        (serialize (build-path (find-system-path 'temp-dir) "home" "hotdogs")
                   #:relative-directory (build-path (find-system-path 'temp-dir) "home"))))
 
+;; Serialize as relative, test for readability
+(let ([s (serialize (build-path (find-system-path 'temp-dir) "home" "hotdogs")
+                    #:relative-directory (build-path (find-system-path 'temp-dir) "home"))])
+  (define-values (in out) (make-pipe))
+  (write s out)
+  (close-output-port out)
+  (test (build-path (or (current-load-relative-directory)
+                        (current-directory))
+                    "hotdogs")
+        'read-path-data
+        (deserialize (read in))))
+
 ;; don't serialize as relative
 (test (build-path (find-system-path 'temp-dir) "home" "hotdogs")
       'path-data
diff --git a/racket/collects/racket/fasl.rkt b/racket/collects/racket/fasl.rkt
index 1bcd0b5d1f..1c4079d7de 100644
--- a/racket/collects/racket/fasl.rkt
+++ b/racket/collects/racket/fasl.rkt
@@ -211,8 +211,7 @@
            (cond
              [rel-elems
               (write-byte fasl-relative-path-type o)
-              (loop (for/list ([p (in-list rel-elems)])
-                      (if (path? p) (path-element->bytes p) p)))]
+              (loop rel-elems)]
              [else
               (write-byte fasl-path-type o)
               (write-fasl-bytes (path->bytes v) o)
diff --git a/racket/collects/racket/private/relative-path.rkt b/racket/collects/racket/private/relative-path.rkt
index 397c589930..593747bce3 100644
--- a/racket/collects/racket/private/relative-path.rkt
+++ b/racket/collects/racket/private/relative-path.rkt
@@ -52,10 +52,11 @@
                    (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]
+                       [(null? exploded-wrt-rel-dir) (map path-element->bytes 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)]))))))]))
+                                     (for/list ([p (in-list rel)])
+                                       (if (path? p) (path-element->bytes p) p)))]))))))]))