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

fix mod-collapse bug with 'up' elements relative to planet paths

Browse Source 
svn: r10229
This commit is contained in:
Matthew Flatt 2008-06-12 12:18:30 +00:00
parent 74dda12d35
commit 930650491f
2 changed files with 14 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/syntax/modcollapse.ss
View File

@ -31,6 +31,13 @@
(let ([m (regexp-match #rx"^(.*/)/*[^/]*$" relto)])
(string-append (cadr m) elem-str)))))
(define (simpler-relpath path)
(let loop ([s (regexp-replace* #px"(?<![.])[.]/" path "")])
(let ([s2 (regexp-replace #rx"([^/.]*)/[.][.]/" s "")])
(if (equal? s s2)
s
(loop s2)))))
(define (add-main s)
(if (regexp-match #rx"[.][^/]*$" s)
s
@ -96,11 +103,7 @@
(string-append s "/"))
(cddr relto-mp))
(list (cadr relto-mp)))))])
(let ([simpler (let loop ([s (regexp-replace* #px"(?<![.])[.]/" path "")])
(let ([s2 (regexp-replace #rx"([^/.]*)/[.][.]/" s "")])
(if (equal? s s2)
s
(loop s2))))])
(let ([simpler (simpler-relpath path)])
(let ([m (regexp-match #rx"^(.*)/([^/]*)$" simpler)])
(if m
(normalize-lib `(lib ,(caddr m) ,(cadr m)))
@ -108,8 +111,9 @@
"relative path escapes collection: ~s relative to ~s"
elements relto-mp))))))]
[(eq? (car relto-mp) 'planet)
(let ([pathstr (attach-to-relative-path-string
elements (cadr relto-mp))])
(let ([pathstr (simpler-relpath
(attach-to-relative-path-string
elements (cadr relto-mp)))])
(normalize-planet `(planet ,pathstr ,(caddr relto-mp))))]
[else (error 'combine-relative-elements
"don't know how to deal with: ~s" relto-mp)]))

3
collects/tests/mzscheme/moddep.ss
View File

@ -116,6 +116,9 @@
(test-cmp '(planet "x.ss" ("m" "z.plt" 2 (- 5))) '(planet "m/z:2:<=5/x.ss") (build-path "yikes"))
(test-cmp '(planet "x.ss" ("m" "z.plt" 2 (7 99))) '(planet "m/z:2:7-99/x.ss") (build-path "yikes"))
(test-cmp '(planet "utils.ss" ("untyped" "unlib.plt" 3 (= 6)))
"../utils.ss" '(planet "doc/stuff.ss" ("untyped" "unlib.plt" 3 (= 6))))
(test-cmp (build-path 'same "x.ss") "x.ss" (build-path 'same))
;; Try path cases that don't fit UTF-8 (and therefore would go wrong as a string):