suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

syntax/modcollapse: repair for submodule referenced from submodule

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
pkgs/racket-test/tests/syntax/modcollapse.rkt
View File

@ -10,7 +10,8 @@
(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)
expected)
@ -54,6 +55,14 @@
`(submod ,here 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
"apple.rkt"
(module-path-index-join
@ -143,3 +152,4 @@
(check (collapse-module-path-index rel-dirrel
here)
(build-path here-dir "x" "apple.rkt"))

5
racket/collects/syntax/private/modcollapse-noctc.rkt
View File

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