From c9d7cc7da46f02f27511f22cfa07de10efd22df6 Mon Sep 17 00:00:00 2001
From: Raphael Sousa Santos <contact@raphaelss.com>
Date: Sat, 25 Jan 2020 18:53:49 +0100
Subject: [PATCH] Add Printexc.default_uncaught_exception_handler (issue #9248)

Printexc.uncaught_exception_handler ceases to be an option ref and becomes
a ref to the handler function initialized to
Printexc.default_uncaught_exception_handler.
---
 Changes             |  3 +++
 stdlib/printexc.ml  | 34 ++++++++++++++++------------------
 stdlib/printexc.mli | 11 +++++++++--
 3 files changed, 28 insertions(+), 20 deletions(-)

diff --git a/Changes b/Changes
index 73a3d8ffb..22911d199 100644
--- a/Changes
+++ b/Changes
@@ -45,6 +45,9 @@ Working version
 
 ### Standard library:
 
+- #9248: Add Printexc.default_uncaught_exception_handler
+  (Raphael Sousa Santos, review by Daniel Bünzli)
+
 - #9235: Add Array.exists2 and Array.for_all2
   (Bernhard Schommer, review by Armaël Guéneau)
 
diff --git a/stdlib/printexc.ml b/stdlib/printexc.ml
index 13d9ebee5..6dc5c211c 100644
--- a/stdlib/printexc.ml
+++ b/stdlib/printexc.ml
@@ -270,10 +270,14 @@ let exn_slot_name x =
   let slot = exn_slot x in
   (Obj.obj (Obj.field slot 0) : string)
 
+let default_uncaught_exception_handler exn raw_backtrace =
+  eprintf "Fatal error: exception %s\n" (to_string exn);
+  print_raw_backtrace stderr raw_backtrace;
+  flush stderr
 
-let uncaught_exception_handler = ref None
+let uncaught_exception_handler = ref default_uncaught_exception_handler
 
-let set_uncaught_exception_handler fn = uncaught_exception_handler := Some fn
+let set_uncaught_exception_handler fn = uncaught_exception_handler := fn
 
 let empty_backtrace : raw_backtrace = Obj.obj (Obj.new_block Obj.abstract_tag 0)
 
@@ -294,22 +298,16 @@ let handle_uncaught_exception' exn debugger_in_use =
         try_get_raw_backtrace ()
     in
     (try Stdlib.do_at_exit () with _ -> ());
-    match !uncaught_exception_handler with
-    | None ->
-        eprintf "Fatal error: exception %s\n" (to_string exn);
-        print_raw_backtrace stderr raw_backtrace;
-        flush stderr
-    | Some handler ->
-        try
-          handler exn raw_backtrace
-        with exn' ->
-          let raw_backtrace' = try_get_raw_backtrace () in
-          eprintf "Fatal error: exception %s\n" (to_string exn);
-          print_raw_backtrace stderr raw_backtrace;
-          eprintf "Fatal error in uncaught exception handler: exception %s\n"
-            (to_string exn');
-          print_raw_backtrace stderr raw_backtrace';
-          flush stderr
+    try
+      !uncaught_exception_handler exn raw_backtrace
+    with exn' ->
+      let raw_backtrace' = try_get_raw_backtrace () in
+      eprintf "Fatal error: exception %s\n" (to_string exn);
+      print_raw_backtrace stderr raw_backtrace;
+      eprintf "Fatal error in uncaught exception handler: exception %s\n"
+        (to_string exn');
+      print_raw_backtrace stderr raw_backtrace';
+      flush stderr
   with
     | Out_of_memory ->
         prerr_endline
diff --git a/stdlib/printexc.mli b/stdlib/printexc.mli
index c15b783d9..6d82befe5 100644
--- a/stdlib/printexc.mli
+++ b/stdlib/printexc.mli
@@ -168,10 +168,17 @@ external get_callstack: int -> raw_backtrace = "caml_get_current_callstack"
 
 (** {1 Uncaught exceptions} *)
 
+val default_uncaught_exception_handler: exn -> raw_backtrace -> unit
+(** [Printexc.default_uncaught_exception_handler] prints the exception and
+    backtrace on standard error output.
+
+    @since 4.11
+*)
+
 val set_uncaught_exception_handler: (exn -> raw_backtrace -> unit) -> unit
 (** [Printexc.set_uncaught_exception_handler fn] registers [fn] as the handler
-    for uncaught exceptions. The default handler prints the exception and
-    backtrace on standard error output.
+    for uncaught exceptions. The default handler is
+    {!Printexc.default_uncaught_exception_handler}.
 
     Note that when [fn] is called all the functions registered with
     {!Stdlib.at_exit} have already been called. Because of this you must