From 294bed209ed903e9ac97095c369edfc9d01ff555 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 14 Feb 2013 06:39:49 -0700 Subject: [PATCH] macro expander fix Repair 73e07f576b added an item to a list without incrementing a counter for the list length, which cause a different element of the list to be dropped, which could mess up binding resolution in arbitrarily bad ways. (Ths bug falls into the "how did this not get exposed earlier?" bin, although part of the answer is that it requires a combination of module re-expansion and simplification of syntax objects in the residual program.) Closes PR 13428 --- collects/tests/racket/macro.rktl | 22 ++++++++++++++++++++++ src/racket/src/syntax.c | 15 ++++++++++++--- 2 files changed, 34 insertions(+), 3 deletions(-) diff --git a/collects/tests/racket/macro.rktl b/collects/tests/racket/macro.rktl index 493f57ce86..33aeef5b6d 100644 --- a/collects/tests/racket/macro.rktl +++ b/collects/tests/racket/macro.rktl @@ -831,4 +831,26 @@ ;; ---------------------------------------- +(parameterize ([current-namespace (make-base-namespace)]) + (define m '(module m racket/base + (require racket/splicing + (for-syntax racket/base)) + + (define-syntax-rule (def id) + (splicing-let ([x +]) + (define-syntax id (let ([v #'(x)]) + (lambda (stx) + v))))) + + (provide def))) + + (eval (if #t + (expand m) + m)) + (namespace-require ''m) + (eval '(def t)) + (eval '(t))) + +;; ---------------------------------------- + (report-errs) diff --git a/src/racket/src/syntax.c b/src/racket/src/syntax.c index 53e2b8b89a..35d475b025 100644 --- a/src/racket/src/syntax.c +++ b/src/racket/src/syntax.c @@ -3161,7 +3161,7 @@ static Scheme_Object *get_old_module_env(Scheme_Object *stx) #define EXPLAIN_RESOLVE 0 #if EXPLAIN_RESOLVE -int scheme_explain_resolves = 0; +int scheme_explain_resolves = 1; # define EXPLAIN(x) if (scheme_explain_resolves) { x; } # define EXPLAIN_FOR_ID "..." #else @@ -4240,6 +4240,7 @@ static Scheme_Object *resolve_env(Scheme_Object *a, Scheme_Object *orig_phase, for (ri = istart; ri < iend; ri++) { renamed = SCHEME_VEC_ELS(rename)[2+ri]; + EXPLAIN(fprintf(stderr, " ? %s @ %p\n", SCHEME_SYM_VAL(SCHEME_STX_SYM(renamed)), rename)); if (SAME_OBJ(SCHEME_STX_VAL(a), SCHEME_STX_SYM(renamed))) { int same; @@ -4257,7 +4258,7 @@ static Scheme_Object *resolve_env(Scheme_Object *a, Scheme_Object *orig_phase, free_id_rename = scheme_void; same = 1; no_lexical = 1; /* simplified table always has final result */ - EXPLAIN(fprintf(stderr, "%d Targes %s <- %s %p\n", depth, + EXPLAIN(fprintf(stderr, "%d Target %s <- %s %p\n", depth, scheme_write_to_string(envname, 0), scheme_write_to_string(other_env, 0), free_id_rename)); @@ -5452,7 +5453,7 @@ static Scheme_Object *simplify_lex_renames(Scheme_Object *wraps, Scheme_Hash_Tab v2l = scheme_null; v2rdl = NULL; - EXPLAIN_S(fprintf(stderr, "[in simplify]\n")); + EXPLAIN_S(fprintf(stderr, "[in simplify %s]\n", scheme_write_to_string(stx_datum, NULL))); EXPLAIN_R(printf("Simplifying %p %s\n", lex_cache, scheme_write_to_string(stx_datum, NULL))); @@ -5967,6 +5968,13 @@ static Scheme_Object *simplify_lex_renames(Scheme_Object *wraps, Scheme_Hash_Tab } } + EXPLAIN_S({ + int k; + for (k = 2; k < SCHEME_VEC_SIZE(v2); k++) { + fprintf(stderr, " %p[%d]: %s\n", v2, k, scheme_write_to_string(SCHEME_VEC_ELS(v2)[k], NULL)); + } + }); + v2l = CONS(v2, v2l); v2rdl = scheme_make_raw_pair((Scheme_Object *)v2_rib_delims, v2rdl); } @@ -6395,6 +6403,7 @@ static Scheme_Object *wraps_to_datum(Scheme_Object *stx_datum, stack = CONS(la, stack); else stack = add_rename_to_stack((Module_Renames *)la, stack, mt, a); + stack_size++; } } }