fix more problems collapsing planet paths

svn: r11489
This commit is contained in:
Matthew Flatt 2008-08-29 21:45:38 +00:00
parent 797c141ede
commit ae9e317b44
3 changed files with 22 additions and 15 deletions

View File

@ -118,16 +118,21 @@
"relative path escapes collection: ~s relative to ~s"
elements relto-mp))))))]
[(eq? (car relto-mp) 'planet)
(let ([pathstr (simpler-relpath
(attach-to-relative-path-string
elements
(apply string-append
(append
(map (lambda (s)
(string-append s "/"))
(cdddr relto-mp))
(list (cadr relto-mp))))))])
(normalize-planet `(planet ,pathstr ,(caddr relto-mp))))]
(let ([relto-mp
;; make sure relto-mp is in long form:
(if (null? (cddr relto-mp))
(normalize-planet relto-mp)
relto-mp)])
(let ([pathstr (simpler-relpath
(attach-to-relative-path-string
elements
(apply string-append
(append
(map (lambda (s)
(string-append s "/"))
(cdddr relto-mp))
(list (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)]))
@ -188,9 +193,9 @@
[(regexp-match? #rx"<=" vers)
`(- ,(string->number (substring vers 2)))]
[(regexp-match? #rx">=" vers)
`(+ ,(string->number (substring vers 2)))]
(string->number (substring vers 2))]
[(regexp-match? #rx"=" vers)
(string->number (substring vers 1))]
`(= ,(string->number (substring vers 1)))]
[(regexp-match #rx"(.*)-(.*)" vers)
=> (lambda (m)
`(,(string->number (cadr m))

View File

@ -13,7 +13,7 @@
Returns a ``simplified'' module path by combining
@scheme[module-path-v] with @scheme[rel-to-module-path-v], where the
latter must have the form @scheme['(lib ....)] or a symbol,
@scheme['(file <string>)], @scheme['(path ....)], a @techlink[#:doc
@scheme['(file <string>)], @scheme['(planet ....)], a @techlink[#:doc
refman]{path}, or a thunk to generate one of those.
The result can be a path if @scheme[module-path-v] contains a path

View File

@ -111,8 +111,8 @@
(test-cmp '(planet "x.ss" ("m" "z.plt" 2)) '(planet "x.ss" ("m" "z.plt" 2)) (build-path "yikes"))
(test-cmp '(planet "x.ss" ("m" "z.plt" 2)) '(planet "m/z:2/x.ss") (build-path "yikes"))
(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 5)) '(planet "m/z:2:=5/x.ss") (build-path "yikes"))
(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 (= 5))) '(planet "m/z:2:=5/x.ss") (build-path "yikes"))
(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 (- 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 "x.ss" ("m" "z.plt" 2 (7 99))) '(planet "m/z:2:7-99/x.ss") (build-path "yikes"))
@ -123,6 +123,8 @@
"../utils.ss" '(planet "stuff.ss" ("untyped" "unlib.plt" 3 (= 6)) "doc"))
(test-cmp '(planet "utils.ss" ("untyped" "unlib.plt" 3 (= 6)) "down")
"../down/utils.ss" '(planet "stuff.ss" ("untyped" "unlib.plt" 3 (= 6)) "doc"))
(test-cmp '(planet "utils.ss" ("untyped" "unlib.plt" 3 (= 6)) "down")
"../down/utils.ss" '(planet untyped/unlib:3:=6/doc/stuff))
(test-cmp (build-path 'same "x.ss") "x.ss" (build-path 'same))