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

View File

@ -98,6 +98,11 @@
(module-path-index-join #f #f '(sub1))) (module-path-index-join #f #f '(sub1)))
`(submod ,(build-path (current-directory) "x.rkt") sub3)) `(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] ;; collapse-module-path[-index]