diff --git a/src/uicommon.ml b/src/uicommon.ml index 930d8fc61..fbd5e94b3 100644 --- a/src/uicommon.ml +++ b/src/uicommon.ml @@ -364,6 +364,10 @@ let exn2string e = Unix.EUNKNOWNERR n -> Format.sprintf " (code %d)" n | _ -> "") (Printexc.get_backtrace ()) + | Stack_overflow -> + "Stack overflow. This could indicate a programming error.\n\n\ + Technical information in case you need to report a bug:\n" + ^ (Printexc.get_backtrace ()) | Invalid_argument s -> Printf.sprintf "Invalid argument: %s\n%s" s (Printexc.get_backtrace ()) | other -> Printf.sprintf "Uncaught exception %s\n%s" diff --git a/src/uigtk3.ml b/src/uigtk3.ml index 1a9bb3ef1..9d599c86c 100644 --- a/src/uigtk3.ml +++ b/src/uigtk3.ml @@ -720,6 +720,13 @@ let fatalError ?(quit=false) message = let fatalErrorHandler = ref (fatalError ~quit:true) +let stackOverflowNoQuitMsg () = + "Stack overflow. This could indicate a programming error.\n\ + You should be able to continue without having to quit \ + the application but the error may repeat.\n\n\ + Technical information in case you need to report a bug:\n" + ^ (Printexc.get_backtrace ()) + (* ------ *) let getFirstRoot () = @@ -4468,6 +4475,7 @@ let start _ = GtkSignal.user_handler := (function | Util.Transient s | Util.Fatal s -> !fatalErrorHandler s + | Stack_overflow -> !fatalErrorHandler (stackOverflowNoQuitMsg ()); | exn -> !fatalErrorHandler (Uicommon.exn2string exn)); (* Ask the Remote module to call us back at regular intervals during