summaryrefslogtreecommitdiff
path: root/src/jib
diff options
context:
space:
mode:
authorBrian Campbell2020-04-27 17:20:46 +0100
committerBrian Campbell2020-04-27 17:20:46 +0100
commitba2e8265c99bc31c9d1eb8829c4b63d7e2ccf3f4 (patch)
treed6604cf75e7deae59c81732e62ebb3a328e15b1a /src/jib
parent54b6277d79c64d15b155fc161d927aa968afafa1 (diff)
Fix try in exception handler jib bug
The have_exception flag wasn't being cleared until after the handler, resulting in false exception reporting.
Diffstat (limited to 'src/jib')
-rw-r--r--src/jib/jib_compile.ml15
1 files changed, 7 insertions, 8 deletions
diff --git a/src/jib/jib_compile.ml b/src/jib/jib_compile.ml
index 34477967..e5dcd8b5 100644
--- a/src/jib/jib_compile.ml
+++ b/src/jib/jib_compile.ml
@@ -664,8 +664,7 @@ let rec compile_aexp ctx (AE_aux (aexp_aux, env, l)) =
let ctyp = ctyp_of_typ ctx typ in
let aexp_setup, aexp_call, aexp_cleanup = compile_aexp ctx aexp in
let try_return_id = ngensym () in
- let handled_exception_label = label "handled_exception_" in
- let fallthrough_label = label "fallthrough_exception_" in
+ let post_exception_handlers_label = label "post_exception_handlers_" in
let compile_case (apat, guard, body) =
let trivial_guard = match guard with
| AE_aux (AE_val (AV_lit (L_aux (L_true, _), _)), _, _)
@@ -686,19 +685,19 @@ let rec compile_aexp ctx (AE_aux (aexp_aux, env, l)) =
@ [icomment "end guard"]
else [])
@ body_setup @ [body_call (CL_id (try_return_id, ctyp))] @ body_cleanup @ destructure_cleanup
- @ [igoto handled_exception_label]
+ @ [igoto post_exception_handlers_label]
in
[iblock case_instrs; ilabel try_label]
in
assert (ctyp_equal ctyp (ctyp_of_typ ctx typ));
[idecl ctyp try_return_id;
itry_block (aexp_setup @ [aexp_call (CL_id (try_return_id, ctyp))] @ aexp_cleanup);
- ijump l (V_call (Bnot, [V_id (have_exception, CT_bool)])) handled_exception_label]
+ ijump l (V_call (Bnot, [V_id (have_exception, CT_bool)])) post_exception_handlers_label;
+ icopy l (CL_id (have_exception, CT_bool)) (V_lit (VL_bool false, CT_bool))]
@ List.concat (List.map compile_case cases)
- @ [igoto fallthrough_label;
- ilabel handled_exception_label;
- icopy l (CL_id (have_exception, CT_bool)) (V_lit (VL_bool false, CT_bool));
- ilabel fallthrough_label],
+ @ [(* fallthrough *)
+ icopy l (CL_id (have_exception, CT_bool)) (V_lit (VL_bool true, CT_bool));
+ ilabel post_exception_handlers_label],
(fun clexp -> icopy l clexp (V_id (try_return_id, ctyp))),
[]