fix incorrect propagation of name via syntax-local-name

Merge to v6.0
This commit is contained in:
Matthew Flatt 2013-12-14 21:11:08 -07:00
parent 80d0b2fcc3
commit 4abe7d2657
2 changed files with 10 additions and 1 deletions

View File

@ -104,4 +104,8 @@
object-name
(eval (read (open-input-string "(let () (define-struct CP (a)) make-CP)")))))
(err/rt-test (let ([unmentionable ((lambda (x #:a a) 1) 1 2)]) 5)
(lambda (exn) (not (regexp-match? #rx"unmentionable" (exn-message exn)))))
(report-errs)

View File

@ -4933,12 +4933,17 @@ compile_expand_app(Scheme_Object *orig_form, Scheme_Comp_Env *env,
/* naya will be prefixed and returned... */
}
} else if (rec[drec].comp) {
Scheme_Object *name, *origname, *gval, *orig_rest_form, *rest_form;
Scheme_Object *name, *origname, *gval, *orig_rest_form, *rest_form, *vname;
name = SCHEME_STX_CAR(form);
origname = name;
vname = rec[drec].value_name;
rec[drec].value_name = scheme_false;
name = scheme_check_immediate_macro(name, env, rec, drec, 0, &gval, NULL, NULL);
rec[drec].value_name = vname;
/* look for ((lambda (x ...) ....) ....) or ((lambda x ....) ....) */
if (SAME_OBJ(gval, scheme_lambda_syntax)) {
Scheme_Object *argsnbody, *d_name;