suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Relative paths should still be readable. (#2172)

Browse Source 
* 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.
This commit is contained in:
Leif Andersen 2018-07-16 18:45:47 -04:00 committed by GitHub
parent 5fd23b18e5
commit 91d059c817
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
3 changed files with 22 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
pkgs/racket-test-core/tests/racket/serialize.rktl
View File

@ -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

3
racket/collects/racket/fasl.rkt
View File

@ -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)

5
racket/collects/racket/private/relative-path.rkt
View File

@ -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)))]))))))]))