From 6cef2e92302984e470d6b45f4c6d33e21a346bd3 Mon Sep 17 00:00:00 2001 From: Jacob Matthews Date: Wed, 15 Mar 2006 16:59:57 +0000 Subject: [PATCH] added tests for planet, fixed some bugs in moddep's planet handling svn: r2433 --- collects/syntax/moddep.ss | 4 ++-- collects/tests/mzscheme/moddep.ss | 15 +++++++++++++-- 2 files changed, 15 insertions(+), 4 deletions(-) diff --git a/collects/syntax/moddep.ss b/collects/syntax/moddep.ss index 0aa1953805..b16e930361 100644 --- a/collects/syntax/moddep.ss +++ b/collects/syntax/moddep.ss @@ -423,7 +423,7 @@ (let ((cols (cdddr s))) `(planet ,(attach-to-relative-path-string - (append (cdr cols) + (append cols (list (cadr s))) ".") ,(caddr s)))] @@ -493,7 +493,7 @@ (list/c (symbols 'file) (and/c string? path-string?)) ;; not quite specific enough of a contract -- it should also spell out what's ;; allowed in the package spec - (cons/c (symbols 'planet) (cons/c (listof any/c) (listof string?))) + (cons/c (symbols 'planet) (cons/c string? (cons/c (listof any/c) (listof string?)))) path-string?)) (define rel-to-module-path-v/c diff --git a/collects/tests/mzscheme/moddep.ss b/collects/tests/mzscheme/moddep.ss index d48e42fc52..fbc787c421 100644 --- a/collects/tests/mzscheme/moddep.ss +++ b/collects/tests/mzscheme/moddep.ss @@ -1,5 +1,4 @@ - -;; FIXME: this file needs tests for planet paths +;; FIXME: this file needs to test resolve-module-path for planet paths (load-relative "loadtest.ss") @@ -55,6 +54,9 @@ (test-rmp (build-path (current-directory) "x.ss") (build-path "x.ss") #f) (void)) + + + (err/rt-test (resolve-module-path "apple.ss" 'no)) (err/rt-test (resolve-module-path "/apple.ss" #f)) (err/rt-test (resolve-module-path "apple.ss/" #f)) @@ -94,6 +96,15 @@ (build-path "x.ss") `(file ,(path->string (build-path (current-directory) "other")))) +(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 "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") + ;; 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"))]) (test-cmp (build-path dir "x.ss")