fix for-syntax `set!' of unbound identifier to be a syntax error

This commit is contained in:
Matthew Flatt 2012-05-14 09:13:20 -06:00
parent e4887f576d
commit ea8a6a1076
2 changed files with 25 additions and 11 deletions

View File

@ -276,7 +276,6 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Test `require' scoping ;; Test `require' scoping
(module fake-prefix-in scheme (module fake-prefix-in scheme
(require scheme/require-syntax) (require scheme/require-syntax)
(define-require-syntax (pseudo-+ stx) (define-require-syntax (pseudo-+ stx)
@ -702,6 +701,14 @@
(module-path-index-resolve (module-path-index-resolve
(car (identifier-binding (car (syntax-property #'one 'origin))))))))]) (car (identifier-binding (car (syntax-property #'one 'origin))))))))])
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check that set! of an unbound for-syntax variable is a syntax error
(err/rt-test (expand '(module m racket/base
(require (for-syntax racket/base))
(begin-for-syntax
(lambda () (set! x 6)))))
exn:fail:syntax?)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

View File

@ -1900,17 +1900,24 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
genv = env->genv; genv = env->genv;
modname = NULL; modname = NULL;
if (genv->module && (genv->disallow_unbound > 0)) { if (genv->module && genv->disallow_unbound) {
/* Free identifier. Maybe don't continue. */ if (genv->disallow_unbound > 0) {
if (flags & (SCHEME_SETTING | SCHEME_REFERENCING)) { /* Free identifier. Maybe don't continue. */
scheme_unbound_syntax(((flags & SCHEME_SETTING) if (flags & (SCHEME_SETTING | SCHEME_REFERENCING)) {
? scheme_set_stx_string scheme_unbound_syntax(((flags & SCHEME_SETTING)
: scheme_var_ref_string), ? scheme_set_stx_string
NULL, src_find_id, "unbound identifier in module"); : scheme_var_ref_string),
return NULL; NULL, src_find_id, "unbound identifier in module");
return NULL;
}
if (flags & SCHEME_NULL_FOR_UNBOUND)
return NULL;
} else {
if (flags & (SCHEME_SETTING | SCHEME_REFERENCING)) {
scheme_register_unbound_toplevel(env, src_find_id);
}
/* continue, for now */
} }
if (flags & SCHEME_NULL_FOR_UNBOUND)
return NULL;
} }
} }