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

bytecode compiler: don't discard set! that should error

Browse Source 
Robby found this bug using the Redex model and random testing.
This commit is contained in:
Matthew Flatt 2018-08-19 17:14:51 -06:00
parent 4128189499
commit 7176fc4253
4 changed files with 16 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
pkgs/racket-test-core/tests/racket/letrec.rktl
View File

@ -168,4 +168,9 @@
(f))) (f)))
letrec-exn?) letrec-exn?)
;; Make sure a useless `set!` isn't discarded early
(err/rt-test
(letrec ((B (begin (set! B B) 1))) 1)
letrec-exn?)
(report-errs) (report-errs)

9
racket/src/racket/src/compile.c
View File

@ -994,7 +994,7 @@ static Scheme_Object *do_let_compile (Scheme_Object *form, Scheme_Comp_Env *orig
use_box = MALLOC_N_ATOMIC(int, 1); use_box = MALLOC_N_ATOMIC(int, 1);
*use_box = -1; *use_box = -1;
} else } else
use_box = 0; use_box = NULL;
scheme_begin_dup_symbol_check(&r); scheme_begin_dup_symbol_check(&r);
@ -1061,6 +1061,7 @@ static Scheme_Object *do_let_compile (Scheme_Object *form, Scheme_Comp_Env *orig
var->mode = SCHEME_VAR_MODE_COMPILE; var->mode = SCHEME_VAR_MODE_COMPILE;
var->compile.use_box = use_box; var->compile.use_box = use_box;
var->compile.use_position = m; var->compile.use_position = m;
var->compile.keep_assignment = 1;
} }
vars[m-pre_k] = var; vars[m-pre_k] = var;
frame = scheme_extend_comp_env(frame, names[m], (Scheme_Object *)var, mutate_frame, 0); frame = scheme_extend_comp_env(frame, names[m], (Scheme_Object *)var, mutate_frame, 0);
@ -1074,7 +1075,7 @@ static Scheme_Object *do_let_compile (Scheme_Object *form, Scheme_Comp_Env *orig
(recursive ? SCHEME_LET_RECURSIVE : 0)); (recursive ? SCHEME_LET_RECURSIVE : 0));
if (recursive) { if (recursive) {
int prev_might_invoke = 0; int prev_might_invoke = 0, j;
int group_clauses = 0; int group_clauses = 0;
Scheme_Object *rhs; Scheme_Object *rhs;
@ -1089,6 +1090,10 @@ static Scheme_Object *do_let_compile (Scheme_Object *form, Scheme_Comp_Env *orig
rhs = compile_expr(rhs, rhs_env, 0); rhs = compile_expr(rhs, rhs_env, 0);
lv->value = rhs; lv->value = rhs;
for (j = lv->count; j--; ) {
lv->vars[j]->compile.keep_assignment = 0;
}
/* Record when this binding doesn't use any or later bindings in /* Record when this binding doesn't use any or later bindings in
the same set. Break bindings into smaller sets based on this the same set. Break bindings into smaller sets based on this
information, we have to be conservative as reflected by information, we have to be conservative as reflected by

4
racket/src/racket/src/optimize.c
View File

@ -705,7 +705,9 @@ int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int flags,
&& (SCHEME_LOCAL_POS(sb->var) == SCHEME_LOCAL_POS(sb->val))) && (SCHEME_LOCAL_POS(sb->var) == SCHEME_LOCAL_POS(sb->val)))
return 1; return 1;
else if (SAME_TYPE(scheme_ir_local_type, SCHEME_TYPE(sb->var)) else if (SAME_TYPE(scheme_ir_local_type, SCHEME_TYPE(sb->var))
&& SAME_OBJ(sb->var, sb->val)) && SAME_OBJ(sb->var, sb->val)
&& ((((Scheme_IR_Local *)sb->var)->mode != SCHEME_VAR_MODE_COMPILE)
|| !((Scheme_IR_Local *)sb->var)->compile.keep_assignment))
return 1; return 1;
} }

1
racket/src/racket/src/schpriv.h
View File

@ -1414,6 +1414,7 @@ typedef struct Scheme_IR_Local
/* To detect uses on right-hand sides in `letrec` */ /* To detect uses on right-hand sides in `letrec` */
int *use_box; int *use_box;
int use_position; int use_position;
int keep_assignment; /* don't optimize away an assignment to this variable */
} compile; } compile;
struct { struct {
/* Maps the variable into the letrec-check pass's frames: */ /* Maps the variable into the letrec-check pass's frames: */