From 4abe7d2657ca9f39284a5f1c0ef5adc626731376 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 14 Dec 2013 21:11:08 -0700 Subject: [PATCH] fix incorrect propagation of name via `syntax-local-name` Merge to v6.0 --- pkgs/racket-pkgs/racket-test/tests/racket/name.rktl | 4 ++++ racket/src/racket/src/compile.c | 7 ++++++- 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/name.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/name.rktl index 7f3e830a24..29b0355cff 100644 --- a/pkgs/racket-pkgs/racket-test/tests/racket/name.rktl +++ b/pkgs/racket-pkgs/racket-test/tests/racket/name.rktl @@ -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) diff --git a/racket/src/racket/src/compile.c b/racket/src/racket/src/compile.c index 50c41548b4..ad45984420 100644 --- a/racket/src/racket/src/compile.c +++ b/racket/src/racket/src/compile.c @@ -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;