macro expander: fix identifier-binding
on fully expanded module
Fix the case of an identifier that is used as a binding in a module but originated from a different module.
This commit is contained in:
parent
bd60509bf6
commit
ccda0e4abb
|
@ -920,6 +920,33 @@
|
|||
|
||||
(test 'yes dynamic-require ''uses-id-not-id* 'answer)
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Check binding in fully expanded module:
|
||||
|
||||
(let ()
|
||||
(define m
|
||||
'(module m racket/kernel
|
||||
(module foo racket
|
||||
(provide def-wrap)
|
||||
(define-syntax-rule (def-wrap)
|
||||
(begin (define y 1) y)))
|
||||
(module bar racket/kernel
|
||||
(#%require (submod ".." foo))
|
||||
(def-wrap))))
|
||||
|
||||
(parameterize ([current-namespace (make-base-namespace)])
|
||||
(define e (expand m))
|
||||
;; (pretty-print (syntax->datum e))
|
||||
(syntax-case e (module)
|
||||
[(module m _
|
||||
(#%mb1
|
||||
_
|
||||
(module bar _
|
||||
(#%mb2
|
||||
(#%require (submod ".." foo))
|
||||
(define-values (y) '1)
|
||||
_))))
|
||||
(test #t list? (identifier-binding #'y))])))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
|
|
@ -3097,6 +3097,7 @@ static Scheme_Object *get_old_module_env(Scheme_Object *stx)
|
|||
WRAP_POS awl;
|
||||
Scheme_Object *a, *last_id = NULL, *cancel_rename_id = scheme_false;
|
||||
Scheme_Object *result_id = scheme_false, *last_pr = NULL, *pr;
|
||||
int saw_rename = 0;
|
||||
|
||||
WRAP_POS_INIT(awl, ((Scheme_Stx *)stx)->wraps);
|
||||
|
||||
|
@ -3155,13 +3156,20 @@ static Scheme_Object *get_old_module_env(Scheme_Object *stx)
|
|||
}
|
||||
last_id = set_identity;
|
||||
}
|
||||
|
||||
/* Only cancel via phase shift after we've seen a rename.
|
||||
Canceling makes submodule contexts work, while not canceling
|
||||
until after a rename makes inspection of a fully-expanded
|
||||
module work in the case that a binding's indentifier cam from
|
||||
another module. */
|
||||
saw_rename = 1;
|
||||
} else if (SCHEME_BOXP(a)) {
|
||||
/* Phase shift: */
|
||||
Scheme_Object *vec;
|
||||
|
||||
vec = SCHEME_BOX_VAL(a);
|
||||
a = SCHEME_VEC_ELS(vec)[5];
|
||||
if (!SCHEME_FALSEP(a))
|
||||
if (saw_rename && !SCHEME_FALSEP(a))
|
||||
cancel_rename_id = a;
|
||||
}
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user