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

fix binding-to-symbol module path translation for `submod'

Browse Source
This commit is contained in:
Matthew Flatt 2012-05-14 21:56:27 -06:00
parent 1067aa59e3
commit ca2659698e
2 changed files with 41 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
collects/racket/private/reqprov.rkt
View File

@ -40,13 +40,25 @@
[(file . _) 'file]
[(submod . _) 'submod])]
[d (syntax->datum stx)])
(if (eq? (car d) kw)
stx
(datum->syntax
stx
(cons kw (cdr d))
stx
stx)))
(cond
[(eq? kw 'submod)
(syntax-case stx ()
[(_ mp . rest)
(let ([new-mp (xlate-path #'mp)])
(if (and (eq? new-mp #'mp)
(eq? (car d) 'submod))
stx
(datum->syntax
stx
(list* kw new-mp #'rest)
stx
stx)))])]
[(eq? (car d) kw) stx]
[else (datum->syntax
stx
(cons kw (cdr d))
stx
stx)]))
stx))
(define-for-syntax (check-lib-form stx)
@ -59,7 +71,8 @@
(define-syntaxes (lib file planet submod)
(let ([t (lambda (stx)
(check-lib-form stx)
(let* ([mod-path (syntax->datum stx)]
(let* ([stx (xlate-path stx)]
[mod-path (syntax->datum stx)]
[namess (syntax-local-module-exports stx)])
(values
(apply

22
collects/tests/racket/module.rktl
View File

@ -595,7 +595,8 @@
(map
eval
'((module service racket
(#%module-begin))
(#%module-begin
(module s racket/base)))
(module good-client racket
(#%module-begin
@ -615,7 +616,24 @@
(rename-in racket/base
[quote dynamic-in]))
(require
(rename-in (dynamic-in service))))))))
(rename-in (dynamic-in service)))))
(module submodule-good-client racket
(#%module-begin
(require
(rename-in racket/base
[quote dynamic-in]))
(require
(rename-in (submod (dynamic-in service) s)))))
(module another-submodule-good-client racket
(#%module-begin
(require
(rename-in racket/base
[quote dynamic-in]
[submod alt:submod]))
(require
(rename-in (alt:submod (dynamic-in service) s))))))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check phase-1 syntax used via for-template