suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

macro expander fix

Browse Source 
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
This commit is contained in:
Matthew Flatt 2013-02-14 06:39:49 -07:00
parent fbee1ed9c7
commit 294bed209e
2 changed files with 34 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
collects/tests/racket/macro.rktl
View File

@ -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)

15
src/racket/src/syntax.c
View File

@ -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++;
}
}
}