fix more problems collapsing planet paths
svn: r11489
This commit is contained in:
parent
797c141ede
commit
ae9e317b44
|
@ -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))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user