[errors] remove "is_handled" logic, turn unhandled into anomalies

We place the check for unhandled exceptions in the `is_anomaly`
function, and consider all the exceptions non-handled by the printers
always anomalies.

This reworks the solution implemented in
ea3909466eaaf86ff212c0a002e5df11e4a979f5 , in particular
`allow_uncaught` cannot be used anymore, all exceptions must install a
printer.

In order to pass the test-suite CI we also had to register some
printers, that were not registered for no reason, forcing clients to
call a post-processing step on errors.

2 files changed, 14 insertions, 20 deletions

diff --git a/lib/cErrors.ml b/lib/cErrors.ml
index e6219e4eeb..a42504701f 100644
--- a/lib/cErrors.ml
+++ b/lib/cErrors.ml
@@ -31,10 +31,6 @@ let make_anomaly ?label pp =
 let anomaly ?loc ?label pp =
   Loc.raise ?loc (Anomaly (label, pp))
 
-let is_anomaly = function
-| Anomaly _ -> true
-| _ -> false
-
 exception UserError of string option * Pp.t (* User errors *)
 
 let todo s = prerr_string ("TODO: "^s^"\n")
@@ -54,6 +50,14 @@ exception Unhandled
 
 let register_handler h = handle_stack := h::!handle_stack
 
+let is_handled e =
+  let is_handled_by h = (try let _ = h e in true with | Unhandled -> false) in
+  List.exists is_handled_by !handle_stack
+
+let is_anomaly = function
+| Anomaly _ -> true
+| exn -> not (is_handled exn)
+
 (** [print_gen] is a general exception printer which tries successively
     all the handlers of a list, and finally a [bottom] handler if all
     others have failed *)
@@ -77,9 +81,12 @@ let where = function
   if !Flags.debug then str "in " ++ str s ++ str ":" ++ spc () else mt ()
 
 let raw_anomaly e = match e with
-  | Anomaly (s, pps) -> where s ++ pps
-  | Assert_failure _ | Match_failure _ -> str (Printexc.to_string e) ++ str "."
-  | _ -> str "Uncaught exception " ++ str (Printexc.to_string e) ++ str "."
+  | Anomaly (s, pps) ->
+    where s ++ pps
+  | Assert_failure _ | Match_failure _ ->
+    str (Printexc.to_string e) ++ str "."
+  | _ ->
+    str "Uncaught exception " ++ str (Printexc.to_string e) ++ str "."
 
 let print_backtrace e = match Backtrace.get_backtrace e with
 | None -> mt ()
@@ -128,12 +135,3 @@ let noncritical = function
   | Invalid_argument "equal: functional value" -> false
   | _ -> true
 [@@@ocaml.warning "+52"]
-
-(** Check whether an exception is handled *)
-
-exception Bottom
-
-let handled e =
-  let bottom _ = raise Bottom in
-  try let _ = print_gen bottom !handle_stack e in true
-  with Bottom -> false
diff --git a/lib/cErrors.mli b/lib/cErrors.mli
index 8bb161d745..51ec5c907a 100644
--- a/lib/cErrors.mli
+++ b/lib/cErrors.mli
@@ -89,7 +89,3 @@ val iprint_no_report : Exninfo.iexn -> Pp.t
     Typical example: [Sys.Break], [Assert_failure], [Anomaly] ...
 *)
 val noncritical : exn -> bool
-
-(** Check whether an exception is handled by some toplevel printer. The
-    [Anomaly] exception is never handled. *)
-val handled : exn -> bool