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

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 = -1;
} else
use_box = 0;
use_box = NULL;
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->compile.use_box = use_box;
var->compile.use_position = m;
var->compile.keep_assignment = 1;
}
vars[m-pre_k] = var;
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));
if (recursive) {
int prev_might_invoke = 0;
int prev_might_invoke = 0, j;
int group_clauses = 0;
Scheme_Object *rhs;
@ -1088,6 +1089,10 @@ static Scheme_Object *do_let_compile (Scheme_Object *form, Scheme_Comp_Env *orig
rhs_env = scheme_set_comp_env_name(frame, NULL);
rhs = compile_expr(rhs, rhs_env, 0);
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
the same set. Break bindings into smaller sets based on this

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)))
return 1;
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;
}

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` */
int *use_box;
int use_position;
int keep_assignment; /* don't optimize away an assignment to this variable */
} compile;
struct {
/* Maps the variable into the letrec-check pass's frames: */