diff options
| author | Brian Campbell | 2020-04-27 17:20:46 +0100 |
|---|---|---|
| committer | Brian Campbell | 2020-04-27 17:20:46 +0100 |
| commit | ba2e8265c99bc31c9d1eb8829c4b63d7e2ccf3f4 (patch) | |
| tree | d6604cf75e7deae59c81732e62ebb3a328e15b1a /src/jib | |
| parent | 54b6277d79c64d15b155fc161d927aa968afafa1 (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.ml | 15 |
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))), [] |
