adjust handling of identifiers without module context by set!
... and `#%variable-reference`, adding a special case for an identifier that is bound in the encloding module.
This commit is contained in:
parent
39195bd04f
commit
d67082ea60
|
@ -1108,7 +1108,7 @@
|
||||||
(eval '(m)))))
|
(eval '(m)))))
|
||||||
|
|
||||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Check a a submodule can be armed:
|
;; Check that a submodule can be armed:
|
||||||
|
|
||||||
(test #t
|
(test #t
|
||||||
syntax?
|
syntax?
|
||||||
|
@ -1118,6 +1118,47 @@
|
||||||
(define-syntax-rule (s) (module x racket/base 10))
|
(define-syntax-rule (s) (module x racket/base 10))
|
||||||
(s)))))
|
(s)))))
|
||||||
|
|
||||||
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Check interaction of marks and a syntax-object side channel
|
||||||
|
|
||||||
|
;; Tests a special case that makes a reference to an identifier in
|
||||||
|
;; the enclosing module work, even though the identifier is missing
|
||||||
|
;; a module context.
|
||||||
|
|
||||||
|
(let ()
|
||||||
|
(define (mk mode wrap?)
|
||||||
|
`(module m racket
|
||||||
|
(require (for-syntax syntax/parse racket/syntax))
|
||||||
|
(define-for-syntax funny #f)
|
||||||
|
(define-syntax (make-funny-set! stx)
|
||||||
|
(syntax-parse stx
|
||||||
|
[(_ v)
|
||||||
|
(define unmarked (generate-temporary))
|
||||||
|
(set! funny (syntax-local-introduce unmarked))
|
||||||
|
#`(define #,unmarked v)]))
|
||||||
|
(define-syntax (funny-ref stx)
|
||||||
|
(syntax-parse stx
|
||||||
|
[(_)
|
||||||
|
funny]))
|
||||||
|
(define-syntax (funny-set! stx)
|
||||||
|
(syntax-parse stx
|
||||||
|
[(_ v)
|
||||||
|
#`(set! #,funny v)]))
|
||||||
|
(define-syntax (funny-varref stx)
|
||||||
|
(syntax-parse stx
|
||||||
|
[(_)
|
||||||
|
#`(#%variable-reference #,funny)]))
|
||||||
|
(make-funny-set! 2)
|
||||||
|
,((if wrap? (lambda (v) `(let () ,v)) values)
|
||||||
|
(case mode
|
||||||
|
[(ref) '(funny-ref)]
|
||||||
|
[(set) '(funny-set! 3)]
|
||||||
|
[(var) '(funny-varref)]))))
|
||||||
|
(for* ([m '(ref set var)]
|
||||||
|
[wrap? '(#t #f)])
|
||||||
|
(parameterize ([current-namespace (make-base-namespace)])
|
||||||
|
(eval (mk m wrap?)))))
|
||||||
|
|
||||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(report-errs)
|
(report-errs)
|
||||||
|
|
|
@ -1909,6 +1909,15 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
|
||||||
modname = NULL;
|
modname = NULL;
|
||||||
|
|
||||||
if (genv->module && genv->disallow_unbound) {
|
if (genv->module && genv->disallow_unbound) {
|
||||||
|
/* double-check for a local-module binding that's not in find_id's context;
|
||||||
|
see a similar test in scheme_check_top_identifier_bound() */
|
||||||
|
find_global_id = scheme_tl_id_sym(genv, find_id, NULL, 0, NULL, NULL);
|
||||||
|
if (!SAME_OBJ(find_global_id, SCHEME_STX_SYM(find_id))) {
|
||||||
|
/* it's defined after all; fall through below assumes a binding
|
||||||
|
in the enclosing module */
|
||||||
|
} else {
|
||||||
|
/* If find_global_id is not find_id, then the module must have a
|
||||||
|
definition of the identifier. */
|
||||||
if (genv->disallow_unbound > 0) {
|
if (genv->disallow_unbound > 0) {
|
||||||
/* Free identifier. Maybe don't continue. */
|
/* Free identifier. Maybe don't continue. */
|
||||||
if (flags & (SCHEME_SETTING | SCHEME_REFERENCING)) {
|
if (flags & (SCHEME_SETTING | SCHEME_REFERENCING)) {
|
||||||
|
@ -1928,6 +1937,7 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
}
|
||||||
|
|
||||||
if (_menv && genv->module)
|
if (_menv && genv->module)
|
||||||
*_menv = genv;
|
*_menv = genv;
|
||||||
|
|
|
@ -5222,7 +5222,10 @@ int scheme_check_top_identifier_bound(Scheme_Object *c, Scheme_Env *genv, int di
|
||||||
|
|
||||||
tl_id = scheme_tl_id_sym(genv, symbol, NULL, 0, NULL, NULL);
|
tl_id = scheme_tl_id_sym(genv, symbol, NULL, 0, NULL, NULL);
|
||||||
if (NOT_SAME_OBJ(tl_id, SCHEME_STX_SYM(symbol))) {
|
if (NOT_SAME_OBJ(tl_id, SCHEME_STX_SYM(symbol))) {
|
||||||
/* Since the module has a rename for this id, it's certainly defined. */
|
/* Since the module has a rename for this id, count it as
|
||||||
|
defined. This covers the unusual case that a marked identifier
|
||||||
|
is bound in a module, but the identifier doesn't have the
|
||||||
|
module's post_ex_rename_set in its lexical information. */
|
||||||
bad = 0;
|
bad = 0;
|
||||||
} else {
|
} else {
|
||||||
modidx = scheme_stx_module_name(NULL, &symbol, scheme_make_integer(genv->phase), NULL, NULL, NULL,
|
modidx = scheme_stx_module_name(NULL, &symbol, scheme_make_integer(genv->phase), NULL, NULL, NULL,
|
||||||
|
|
Loading…
Reference in New Issue
Block a user