diff --git a/CHANGELOG.md b/CHANGELOG.md index b7f9faf..5a70b26 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,7 @@ * Fix breakpoints resolution algorithm. * Fix variables pane sometimes flooding by `Assertion_failure(...)` raised at Env_hack.ml. * Fix incorrectly inspect 'a type as int. +* Output to debug console when uncaught_exc occurs. ## 1.0.2 - 2021-02-22 diff --git a/src/adapter/inspect.ml b/src/adapter/inspect.ml index 77a31a7..66c2e25 100644 --- a/src/adapter/inspect.ml +++ b/src/adapter/inspect.ml @@ -32,7 +32,13 @@ let run ~init_args ~launch_args ~dbg rpc = Hashtbl.reset value_tbl; match status with | Running -> Lwt.return () - | Stopped (Exited | Uncaught_exc) -> + | Stopped ((Exited | Uncaught_exc) as reason) -> + if reason = Uncaught_exc then + Debug_rpc.send_event rpc + (module Output_event) + Output_event.Payload.( + make ~output:"Program exited due to Uncaught_exc" ()) + else Lwt.return ();%lwt Debug_rpc.send_event rpc (module Terminated_event) Terminated_event.Payload.(make ()) @@ -146,7 +152,8 @@ let run ~init_args ~launch_args ~dbg rpc = let num_named = value#num_named in let num_indexed = value#num_indexed in let is_complex = - num_indexed > 0 || num_named > 0 || num_named = -1 || Option.is_some value#vscode_menu_context + num_indexed > 0 || num_named > 0 || num_named = -1 + || Option.is_some value#vscode_menu_context in let handle = if is_complex then alloc_handle () else 0 in Hashtbl.replace value_tbl handle value; @@ -184,5 +191,6 @@ let run ~init_args ~launch_args ~dbg rpc = let open VariableGetClosureCodeLocation in match Hashtbl.find_opt value_tbl arg.handle with | None -> Lwt.return { Result.location = None } - | Some value -> Lwt.return { Result.location = value#closure_code_location }); + | Some value -> + Lwt.return { Result.location = value#closure_code_location }); Lwt.join [ process_state_changes () ] diff --git a/src/debugger/core/controller.ml b/src/debugger/core/controller.ml index 459cbd5..3681e7d 100644 --- a/src/debugger/core/controller.ml +++ b/src/debugger/core/controller.ml @@ -56,9 +56,9 @@ let _set_frag_events symbols conn frag = |> Seq.map (fun it -> (module_.frag, it.ev_pos))) |> Lwt_seq.iter_s (Wire_protocol.set_event conn);%lwt Lwt.return - ( debug_modules + (debug_modules |> Seq.map (fun (it : Code_module.t) -> (it.frag, it.module_id)) - |> FragModuleIdSet_.of_seq ) + |> FragModuleIdSet_.of_seq) let root ?debug_filter debug_sock symbols_file = let%lwt fd, _ = Lwt_unix.accept debug_sock in @@ -94,7 +94,7 @@ let fork t debug_sock = if pid' = pid then Lwt.return conn else ( Lwt_unix.close fd;%lwt - wait_conn () ) + wait_conn ()) in let%lwt conn = wait_conn () in Lwt.return @@ -133,14 +133,14 @@ let stop ?(gracefully = false) t = if gracefully then Wire_protocol.stop t.conn else ( Unix.kill t.pid 9; - Lwt.return () );%lwt + Lwt.return ());%lwt t.dead <- true; let () = match t.parent with | None -> () | Some parent -> Lwt.async (fun () -> Wire_protocol.wait parent.conn) in - Lwt.return () ) + Lwt.return ()) let execute ?(yield_steps = Int.max_int) ?(on_yield = fun () -> Lwt.return `Continue) ?trap_barrier @@ -197,33 +197,31 @@ let execute ?(yield_steps = Int.max_int) let%lwt r = run () in if not (t.breakpoints |> PcSet_.mem pc) then ( Wire_protocol.reset_instr t.conn pc;%lwt - Wire_protocol.set_event t.conn pc ) + Wire_protocol.set_event t.conn pc) else Lwt.return ();%lwt Lwt.return r in - let run = - match trap_barrier with - | None -> run - | Some trap_barrier -> - fun () -> - Wire_protocol.set_trap_barrier t.conn trap_barrier;%lwt - let%lwt summary, remaining_steps, sp_pc = run () in - Wire_protocol.set_trap_barrier t.conn 0;%lwt - if summary = `Trap_barrier then - let stop_on_event () = - let%lwt summary', remaining_steps', sp_pc' = exec_dynlink _1 in - let remaining_steps = - remaining_steps ++ (_1 -- remaining_steps') - in - match summary' with - | `Trap_barrier -> assert false - | `Event | `Breakpoint -> - Lwt.return (`Trap_barrier, remaining_steps, sp_pc') - | `Exited | `Uncaught_exc | `Yield_stop _ -> - Lwt.return (summary', remaining_steps, sp_pc') - in - stop_on_event () - else Lwt.return (summary, remaining_steps, sp_pc) + let run () = + let%lwt () = + match trap_barrier with + | None -> Lwt.return () + | Some trap_barrier -> Wire_protocol.set_trap_barrier t.conn trap_barrier + in + let%lwt summary, remaining_steps, sp_pc = run () in + Wire_protocol.set_trap_barrier t.conn 0;%lwt + if summary = `Trap_barrier then + let rec stop_on_event () = + let%lwt summary', remaining_steps', sp_pc' = exec_dynlink _1 in + let remaining_steps = remaining_steps ++ (_1 -- remaining_steps') in + match summary' with + | `Trap_barrier -> stop_on_event () + | `Event | `Breakpoint -> + Lwt.return (`Trap_barrier, remaining_steps, sp_pc') + | `Exited | `Uncaught_exc | `Yield_stop _ -> + Lwt.return (summary', remaining_steps, sp_pc') + in + stop_on_event () + else Lwt.return (summary, remaining_steps, sp_pc) in let%lwt summary, remaining_steps, sp_pc = run () in if summary = `Exited || summary = `Uncaught_exc then stop ~gracefully:true t diff --git a/src/debugger/debugger.ml b/src/debugger/debugger.ml index 946edbe..e2acab6 100644 --- a/src/debugger/debugger.ml +++ b/src/debugger/debugger.ml @@ -274,7 +274,9 @@ let _summary_to_reason summary = match summary with | `Event -> Step | `Yield_stop 1 -> Pause - | `Yield_stop _ | `Trap_barrier -> raise (Invalid_argument "summary") + | `Yield_stop x -> + raise (Invalid_argument ("summary is `Yield_stop " ^ string_of_int x)) + | `Trap_barrier -> raise (Invalid_argument "summary is `Trap_barrier") | `Breakpoint -> Breakpoint | `Exited -> Exited | `Uncaught_exc -> Uncaught_exc