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:
parent
9c4cfdecc4
commit
a6cfe3d5fb
|
@ -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) ".")
|
||||||
|
|
|
@ -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]
|
||||||
|
|
Loading…
Reference in New Issue
Block a user