fix bug and test for `path->relative-string/library'

This commit is contained in:
Matthew Flatt 2013-07-07 11:58:35 -06:00
parent e3c27b2737
commit eb8fc26c59
2 changed files with 4 additions and 2 deletions

View File

@ -16,7 +16,7 @@
(test lib-expected path->relative-string/library path)) (test lib-expected path->relative-string/library path))
(test-both missing missing) (test-both missing missing)
(test-both relative relative) (test-both relative relative)
(test-both collects "racket/foo.rkt" "<collects>/racket/foo.rkt") (test-both collects "<collects>/racket/foo.rkt" "<collects>/racket/foo.rkt")
(err/rt-test (path->relative-string/setup #f)) (err/rt-test (path->relative-string/setup #f))
(err/rt-test (path->relative-string/setup #"bleh")) (err/rt-test (path->relative-string/setup #"bleh"))
(err/rt-test (path->relative-string/setup 'bleh))) (err/rt-test (path->relative-string/setup 'bleh)))

View File

@ -56,7 +56,9 @@
(cons find-planet-dir "<planet>/")))) (cons find-planet-dir "<planet>/"))))
(define (make-default cache default) (define (make-default cache default)
(lambda (x) (lambda (x)
(define-values (pkg sub) (path->pkg+subpath x #:cache cache)) (define-values (pkg sub) (if (complete-path? x)
(path->pkg+subpath x #:cache cache)
(values #f #f)))
(cond (cond
[pkg [pkg
(apply string-append (apply string-append