fix `resolve-module-path-index' when w.r.t. is submodule

A submodule path on the w.r.t. path was incorrectly (in most
cases) added to the resolved path.
This commit is contained in:
Matthew Flatt 2012-11-11 06:26:57 -07:00
parent 9c4cfdecc4
commit a6cfe3d5fb
2 changed files with 17 additions and 18 deletions

View File

@ -67,34 +67,28 @@
[(string? s)
;; Parse Unix-style relative path string
(define-values (dir submod) (get-dir))
(combine-submod
(path-ss->rkt
(apply build-path dir (explode-relpath-string s)))
submod)]
(path-ss->rkt
(apply build-path dir (explode-relpath-string s)))]
[(and (or (not (pair? s)) (not (list? s))) (not (path? s)))
#f]
[(or (path? s) (eq? (car s) 'file))
(let ([p (if (path? s) s (expand-user-path (cadr s)))])
(define-values (d submod) (get-dir))
(combine-submod
(path-ss->rkt
(path->complete-path
p
(if (path-string? d)
d
(or (current-load-relative-directory)
(current-directory)))))
submod))]
(path-ss->rkt
(path->complete-path
p
(if (path-string? d)
d
(or (current-load-relative-directory)
(current-directory))))))]
[(or (eq? (car s) 'lib)
(eq? (car s) 'quote)
(eq? (car s) 'planet))
;; use resolver handler in this case, too:
(define-values (d submod) (force-relto relto #f #:path? #f))
(combine-submod
(resolved-module-path-name
(module-path-index-resolve
(module-path-index-join s #f)))
submod)]
(resolved-module-path-name
(module-path-index-resolve
(module-path-index-join s #f)))]
[(eq? (car s) 'submod)
(define r (cond
[(or (equal? (cadr s) ".")

View File

@ -98,6 +98,11 @@
(module-path-index-join #f #f '(sub1)))
`(submod ,(build-path (current-directory) "x.rkt") sub3))
(test (build-path (current-directory) "z.rkt")
resolve-module-path-index
(module-path-index-join "z.rkt" #f)
`(submod ,(build-path (current-directory) "x.rkt") sub3))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; collapse-module-path[-index]