From 26d4346984d6891555e28fb6cec8be4b13ae2dfc Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 6 Jun 2008 15:57:56 +0000 Subject: [PATCH] moddep tests svn: r10179 --- collects/syntax/modcollapse.ss | 4 +- collects/syntax/scribblings/modcollapse.scrbl | 6 +-- collects/tests/mzscheme/all.ss | 1 + collects/tests/mzscheme/moddep.ss | 37 ++++++++++++------- 4 files changed, 31 insertions(+), 17 deletions(-) diff --git a/collects/syntax/modcollapse.ss b/collects/syntax/modcollapse.ss index c390b117e4..14c4dce838 100644 --- a/collects/syntax/modcollapse.ss +++ b/collects/syntax/modcollapse.ss @@ -7,7 +7,7 @@ "private/modhelp.ss") (define (collapse-module-path s relto-mp) - ;; relto-mp should be a relative path, '(lib relative-path collection), + ;; relto-mp should be a path, '(lib relative-path collection) or symbol, ;; or '(file path) or a thunk that produces one of those ;; Used for 'lib paths, so it's always Unix-style @@ -47,6 +47,7 @@ elements))) (when (procedure? relto-mp) (set! relto-mp (relto-mp))) + (when (symbol? relto-mp) (set! relto-mp `(lib ,(symbol->string relto-mp)))) (cond [(or (path? relto-mp) (and (string? relto-mp) (ormap path? elements))) (apply build-path @@ -224,6 +225,7 @@ (define simple-rel-to-module-path-v/c (or/c (and/c module-path? (or/c + symbol? (cons/c (symbols 'lib) any/c) (cons/c (symbols 'file) any/c) (cons/c (symbols 'planet) any/c) diff --git a/collects/syntax/scribblings/modcollapse.scrbl b/collects/syntax/scribblings/modcollapse.scrbl index b4d9bf148c..f5b71b4f0e 100644 --- a/collects/syntax/scribblings/modcollapse.scrbl +++ b/collects/syntax/scribblings/modcollapse.scrbl @@ -12,9 +12,9 @@ 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 ....)], @scheme['(file -)], @scheme['(path ....)], a @techlink[#:doc refman]{path}, or -a thunk to generate one of those. +latter must have the form @scheme['(lib ....)] or a symbol, +@scheme['(file )], @scheme['(path ....)], 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 element that is needed for the result, or if diff --git a/collects/tests/mzscheme/all.ss b/collects/tests/mzscheme/all.ss index 192e77a6ce..12dac8bc3d 100644 --- a/collects/tests/mzscheme/all.ss +++ b/collects/tests/mzscheme/all.ss @@ -3,6 +3,7 @@ (load-relative "mz.ss") (load-relative "scheme.ss") (load-relative "mzlib.ss") +(load-in-sandbox "moddep.ss") (load-in-sandbox "boundmap-test.ss") (load-in-sandbox "net.ss") (load-in-sandbox "foreign-test.ss") diff --git a/collects/tests/mzscheme/moddep.ss b/collects/tests/mzscheme/moddep.ss index dc35d5ef03..718d73f4e3 100644 --- a/collects/tests/mzscheme/moddep.ss +++ b/collects/tests/mzscheme/moddep.ss @@ -80,16 +80,21 @@ (module-path-index-join #f #f))) rel-to)) -(test-cmp '(lib "x.ss" "nonesuch") "x.ss" '(lib "y.ss" "nonesuch")) -(test-cmp '(lib "x.ss" "nonesuch") "x.ss" (lambda () '(lib "y.ss" "nonesuch"))) -(test-cmp '(lib "down/x.ss" "nonesuch") "down/x.ss" '(lib "y.ss" "nonesuch")) -(test-cmp '(lib "x.ss" "mzlib") '(lib "x.ss") '(lib "y.ss" "nonesuch")) -(test-cmp '(lib "../x.ss" "nonesuch/private") "../x.ss" '(lib "y.ss" "nonesuch/private")) -(test-cmp '(lib "private/../x.ss" "nonesuch") "../x.ss" '(lib "private/y.ss" "nonesuch")) -(test-cmp '(lib "private/x.ss" "alsonot") '(lib "x.ss" "alsonot" "private") '(lib "y.ss" "nonesuch")) +(test-cmp '(lib "nonesuch/x.ss") "x.ss" '(lib "y.ss" "nonesuch")) +(test-cmp '(lib "nonesuch/x.ss") "x.ss" (lambda () '(lib "y.ss" "nonesuch"))) +(test-cmp '(lib "nonesuch/down/x.ss") "down/x.ss" '(lib "y.ss" "nonesuch")) +(test-cmp '(lib "mzlib/x.ss") '(lib "x.ss") '(lib "y.ss" "nonesuch")) +(test-cmp '(lib "nonesuch/x.ss") "../x.ss" '(lib "y.ss" "nonesuch/private")) +(test-cmp '(lib "nonesuch/x.ss") "../x.ss" '(lib "private/y.ss" "nonesuch")) +(test-cmp '(lib "alsonot/private/x.ss") '(lib "x.ss" "alsonot" "private") '(lib "y.ss" "nonesuch")) +(test-cmp '(lib "x" "nonesuch") "x" '(lib "y.ss" "nonesuch")) +(test-cmp '(lib "x" "nonesuch") "x" 'nonesuch/y) +(test-cmp '(lib "x" "nonesuch") "x" 'nonesuch) +(test-cmp '(lib "nonesuch/y.ss") 'nonesuch/y (current-directory)) +(test-cmp '(lib "mzlib/nonesuch.ss") '(lib "nonesuch.ss") (current-directory)) (test-cmp (build-path (current-directory) "x.ss") "x.ss" (build-path (current-directory) "other")) -(test-cmp `(file ,(path->string (build-path (current-directory) "x.ss"))) +(test-cmp (build-path (current-directory) "x.ss") "x.ss" `(file ,(path->string (build-path (current-directory) "other")))) (test-cmp (build-path (current-directory) "x.ss") @@ -99,13 +104,19 @@ (test-cmp '(planet "x.ss" ("usr" "pkg.plt" 1)) "x.ss" '(planet "y.ss" ("usr" "pkg.plt" 1))) (test-cmp '(planet "x.ss" ("usr" "pkg.plt" 1 0)) "x.ss" (lambda () '(planet "y.ss" ("usr" "pkg.plt" 1 0)))) (test-cmp '(planet "path/x.ss" ("a" "p.plt" 1)) "path/x.ss" '(planet "z.ss" ("a" "p.plt" 1))) -(test-cmp '(planet "path/../x.ss" ("a" "p.plt" 2)) "../x.ss" '(planet "path/z.ss" ("a" "p.plt" 2))) +(test-cmp '(planet "path/qq/x.ss" ("a" "p.plt" 2)) "qq/x.ss" '(planet "path/z.ss" ("a" "p.plt" 2))) (test-cmp '(planet "x.ss" ("m" "z.plt" 2)) '(planet "x.ss" ("m" "z.plt" 2)) '(planet "o.ss" ("a" "q.plt" 54 3))) (test-cmp '(planet "x.ss" ("m" "z.plt" 2)) '(planet "x.ss" ("m" "z.plt" 2)) '(lib "o.ss" "nonesuch")) (test-cmp '(planet "x.ss" ("m" "z.plt" 2)) '(planet "x.ss" ("m" "z.plt" 2)) '(file "q.ss")) -(test-cmp '(planet "x.ss" ("m" "z.plt" 2)) '(planet "x.ss" ("m" "z.plt" 2)) "where/in/the/world/cs.ss") +(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 (7 99))) '(planet "m/z:2:7-99/x.ss") (build-path "yikes")) -(test-cmp "./x.ss" "x.ss" ".") +(test-cmp (string->path "./x.ss") "x.ss" (build-path 'same)) ;; Try path cases that don't fit UTF-8 (and therefore would go wrong as a string): (let ([dir (build-path (current-directory) (bytes->path #"\xFF"))]) @@ -116,7 +127,7 @@ (bytes->path #"\xFF") `(file ,(path->string (build-path (current-directory) "other")))) -(test '(lib "x.ss" "alsonot") +(test '(lib "alsonot/x.ss") collapse-module-path-index (module-path-index-join "x.ss" (module-path-index-join @@ -124,7 +135,7 @@ (module-path-index-join #f #f))) '(lib "w.ss" "nonesuch")) -(err/rt-test (collapse-module-path "apple.ss" 'no)) +(err/rt-test (collapse-module-path "apple.ss" '(no))) (err/rt-test (collapse-module-path "/apple.ss" (current-directory))) (err/rt-test (collapse-module-path-index "apple.ss" (current-directory)))