syntax/modcollapse: repair for submodule referenced from submodule

While cross-submodule references within a top-level module worked
right, submodule references across top-level modules did not work
right.
This commit is contained in:
Matthew Flatt 2016-04-01 15:25:50 -06:00
parent 161a9edb57
commit 794061ba1d
2 changed files with 14 additions and 3 deletions

View File

@ -10,7 +10,8 @@
(define self (module-path-index-join #f #f)) (define self (module-path-index-join #f #f))
(define (check-collapse p expected [relative-expected expected]) (define (check-collapse p expected [relative-expected expected]
#:here [here here])
(check (collapse-module-path p here) (check (collapse-module-path p here)
expected) expected)
@ -54,6 +55,14 @@
`(submod ,here test) `(submod ,here test)
'(submod "." test)) '(submod "." test))
(check-collapse '(submod "local.rkt" test)
`(submod ,(build-path here-dir "local.rkt") test)
'(submod "local.rkt" test))
(check-collapse '(submod "local.rkt" test)
`(submod ,(build-path here-dir "local.rkt") test)
`(submod "local.rkt" test)
#:here `(submod ,here other))
(define rel-rel (module-path-index-join (define rel-rel (module-path-index-join
"apple.rkt" "apple.rkt"
(module-path-index-join (module-path-index-join
@ -143,3 +152,4 @@
(check (collapse-module-path-index rel-dirrel (check (collapse-module-path-index rel-dirrel
here) here)
(build-path here-dir "x" "apple.rkt")) (build-path here-dir "x" "apple.rkt"))

View File

@ -327,7 +327,7 @@ Use syntax/modcollapse instead.
(flatten-relto-mp!) (flatten-relto-mp!)
(normalize-submod `(submod ,relto-mp ,@relto-submod ,@(cdr s)))] (normalize-submod `(submod ,relto-mp ,@relto-submod ,@(cdr s)))]
[else [else
(normalize-submod `(submod ,(normalize-recur (cadr s)) ,@relto-submod ,@(cddr s)))])] (normalize-submod `(submod ,(normalize-recur (cadr s)) ,@(cddr s)))])]
[else #f]))) [else #f])))
(define collapse-module-path-index (define collapse-module-path-index
@ -360,7 +360,8 @@ Use syntax/modcollapse instead.
(let ([r (force-relto relto-mp)] (let ([r (force-relto relto-mp)]
[sm (module-path-index-submodule mpi)]) [sm (module-path-index-submodule mpi)])
(if sm (if sm
(if (and (pair? r) (eq? (car r) 'submod)) (if (and (pair? r)
(eq? (car r) 'submod))
(append r sm) (append r sm)
(list* 'submod r sm)) (list* 'submod r sm))
r))))])) r))))]))