From 0da72e931ae1585306f47a6bee8e5f78f48afde1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?T=C3=B5ivo=20Leedj=C3=A4rv?= Date: Fri, 1 Mar 2024 15:49:03 +0100 Subject: [PATCH 1/4] Execute less code when retrying after an error In text UI, when retrying after an error in repeat mode, unnecessary amount of code was being re-executed on each retry. This patch removes the early init code from the retry loop as it only needs to be executed once and will either succeed or fail, there is no retry. (best reviewed with whitespace ignored) --- src/uitext.ml | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/src/uitext.ml b/src/uitext.ml index 363e1cb2d..097589e73 100644 --- a/src/uitext.ml +++ b/src/uitext.ml @@ -1620,11 +1620,13 @@ let rec start interface = handleException e; exit Uicommon.fatalExit end; + start2 () - (* Uncaught exceptions up to this point are non-recoverable, treated - as permanent and will inevitably exit the process. Uncaught exceptions - from here onwards are treated as potentially temporary or recoverable. - The process does not have to exit if in repeat mode and can try again. *) +(* Uncaught exceptions up to this point are non-recoverable, treated + as permanent and will inevitably exit the process. Uncaught exceptions + from here onwards are treated as potentially temporary or recoverable. + The process does not have to exit if in repeat mode and can try again. *) +and start2 () = begin try if Prefs.read silent then Prefs.set Trace.terse true; @@ -1684,7 +1686,7 @@ let rec start interface = Util.msg "\nRestarting in 10 seconds...\n\n"; begin try interruptibleSleep 10 with Sys.Break -> exit Uicommon.fatalExit end; - if safeStopRequested () then exit Uicommon.fatalExit else start interface + if safeStopRequested () then exit Uicommon.fatalExit else start2 () end end From 45989086f0f144edaf5bfbd9b754319e515d403a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?T=C3=B5ivo=20Leedj=C3=A4rv?= Date: Fri, 1 Mar 2024 15:49:03 +0100 Subject: [PATCH 2/4] Execute text UI preferences init code only once This patch moves execution of some text UI preferences init code, which does not need to be repeated every time, out of the retry loop (that is, from after a successful connection to before attempting the connection). (best reviewed with moves highlighted and indentation ignored; for example: --color-moved --color-moved-ws=allow-indentation-change) --- src/uitext.ml | 29 ++++++++++++++--------------- 1 file changed, 14 insertions(+), 15 deletions(-) diff --git a/src/uitext.ml b/src/uitext.ml index 097589e73..8b20ece01 100644 --- a/src/uitext.ml +++ b/src/uitext.ml @@ -1620,6 +1620,20 @@ let rec start interface = handleException e; exit Uicommon.fatalExit end; + + (* Some preference settings imply others... *) + if Prefs.read silent then begin + Prefs.set Globals.batch true; + Prefs.set Trace.terse true; + Prefs.set dumbtty true; + Trace.sendLogMsgsToStderr := false; + end; + if Prefs.read Uicommon.repeat <> `NoRepeat then begin + Prefs.set Globals.batch true; + end; + setColorPreference (); + Trace.statusFormatter := formatStatus; + start2 () (* Uncaught exceptions up to this point are non-recoverable, treated @@ -1628,8 +1642,6 @@ let rec start interface = The process does not have to exit if in repeat mode and can try again. *) and start2 () = begin try - if Prefs.read silent then Prefs.set Trace.terse true; - Uicommon.connectRoots ~displayWaitMessage (); if Prefs.read Uicommon.testServer then exit 0; @@ -1640,25 +1652,12 @@ and start2 () = exit 0 end; - (* Some preference settings imply others... *) - if Prefs.read silent then begin - Prefs.set Globals.batch true; - Prefs.set Trace.terse true; - Prefs.set dumbtty true; - Trace.sendLogMsgsToStderr := false; - end; - if Prefs.read Uicommon.repeat <> `NoRepeat then begin - Prefs.set Globals.batch true; - end; - setColorPreference (); - (* Tell OCaml that we want to catch Control-C ourselves, so that we get a chance to reset the terminal before exiting *) Sys.catch_break true; (* Put the terminal in cbreak mode if possible *) if not (Prefs.read Globals.batch) then setupTerminal(); setWarnPrinter(); - Trace.statusFormatter := formatStatus; let exitStatus = synchronizeUntilDone() in From d4a2387de8b05cdc8403d5dd922aaf290ec9e97b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?T=C3=B5ivo=20Leedj=C3=A4rv?= Date: Sat, 2 Mar 2024 19:14:15 +0100 Subject: [PATCH 3/4] Clean up exception handling and retry code Clean up the exception matching and retry handling code, to unify UI termination and reduce code duplication. --- src/uitext.ml | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/src/uitext.ml b/src/uitext.ml index 8b20ece01..a2aaccf97 100644 --- a/src/uitext.ml +++ b/src/uitext.ml @@ -1641,6 +1641,15 @@ let rec start interface = from here onwards are treated as potentially temporary or recoverable. The process does not have to exit if in repeat mode and can try again. *) and start2 () = + let noRepeat = + Prefs.read Uicommon.repeat = `NoRepeat + || Prefs.read Uicommon.runtests + || Prefs.read Uicommon.testServer + in + let terminate () = + handleException Sys.Break; + exit Uicommon.fatalExit + in begin try Uicommon.connectRoots ~displayWaitMessage (); @@ -1664,14 +1673,9 @@ and start2 () = (* Put the terminal back in "sane" mode, if necessary, and quit. *) restoreTerminal(); exit exitStatus - with - Sys.Break -> begin - (* If we've been killed, then die *) - handleException Sys.Break; - exit Uicommon.fatalExit - end - | e when breakRepeat e -> begin + | Sys.Break -> terminate () + | e when noRepeat || breakRepeat e -> begin handleException e; exit Uicommon.fatalExit end @@ -1679,13 +1683,10 @@ and start2 () = (* If any other bad thing happened and the -repeat preference is set, then restart *) handleException e; - if Prefs.read Uicommon.repeat = `NoRepeat - || Prefs.read Uicommon.runtests then - exit Uicommon.fatalExit; Util.msg "\nRestarting in 10 seconds...\n\n"; - begin try interruptibleSleep 10 with Sys.Break -> exit Uicommon.fatalExit end; - if safeStopRequested () then exit Uicommon.fatalExit else start2 () + begin try interruptibleSleep 10 with Sys.Break -> terminate () end; + if safeStopRequested () then terminate () else start2 () end end From ef6067633857a4d84f04a38cb540d30aa557d364 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?T=C3=B5ivo=20Leedj=C3=A4rv?= Date: Fri, 1 Mar 2024 16:49:05 +0100 Subject: [PATCH 4/4] Classify/Label errors in the UI, not in [exn2str] The [exn2str] function used to add superfluous labels to error messages, in some cases classifying errors as fatal or not (historically likely at least partially due to debugging needs). This function does not know the consequences of the error nor further actions to be taken. These labels can then become misleading. These labels, if needed at all, should be under the control of each respective UI. --- src/uicommon.ml | 11 ++++++----- src/uigtk3.ml | 16 ++++++++-------- src/uitext.ml | 5 ++++- 3 files changed, 18 insertions(+), 14 deletions(-) diff --git a/src/uicommon.ml b/src/uicommon.ml index fbd5e94b3..540eeaf3d 100644 --- a/src/uicommon.ml +++ b/src/uicommon.ml @@ -353,10 +353,10 @@ let reconItem2string oldPath theRI status = let exn2string e = match e with Sys.Break -> "Terminated!" - | Util.Fatal(s) -> Printf.sprintf "Fatal error: %s" s - | Util.Transient(s) -> Printf.sprintf "Error: %s" s + | Util.Fatal s -> s + | Util.Transient s -> s | Unix.Unix_error (err, fun_name, arg) -> - Printf.sprintf "Uncaught unix error: %s failed%s: %s%s\n%s" + Printf.sprintf "Uncaught unix error (please report a bug): %s failed%s: %s%s\n%s" fun_name (if String.length arg > 0 then Format.sprintf " on \"%s\"" arg else "") (Unix.error_message err) @@ -369,8 +369,9 @@ let exn2string e = 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" + Printf.sprintf "Invalid argument (please report a bug): %s\n%s" + s (Printexc.get_backtrace ()) + | other -> Printf.sprintf "Uncaught exception (please report a bug): %s\n%s" (Printexc.to_string other) (Printexc.get_backtrace ()) (* precondition: uc = File (Updates(_, ..) on both sides *) diff --git a/src/uigtk3.ml b/src/uigtk3.ml index 9d599c86c..352f5d290 100644 --- a/src/uigtk3.ml +++ b/src/uigtk3.ml @@ -299,7 +299,7 @@ let primaryText msg = chosen, false if the second button is chosen. *) let twoBox ?(kind=`DIALOG_WARNING) ~parent ~title ~astock ~bstock message = let t = - GWindow.dialog ~parent ~border_width:6 ~modal:true + GWindow.dialog ~parent ~title ~border_width:6 ~modal:true ~resizable:false () in t#vbox#set_spacing 12; let h1 = GPack.hbox ~border_width:6 ~spacing:12 ~packing:t#vbox#pack () in @@ -345,7 +345,7 @@ let warnBox ~parent title message = if Prefs.read Globals.batch then begin (* In batch mode, just pop up a window and go ahead *) let t = - GWindow.dialog ~parent + GWindow.dialog ~parent ~title ~border_width:6 ~modal:true ~resizable:false () in t#vbox#set_spacing 12; let h1 = GPack.hbox ~border_width:6 ~spacing:12 ~packing:t#vbox#pack () in @@ -685,11 +685,11 @@ let gui_safe_eprintf fmt = if System.has_stderr ~info:s then Printf.eprintf "%s%!" s) fmt let fatalError ?(quit=false) message = + let title = if quit then "Fatal error" else "Error" in let () = Trace.sendLogMsgsToStderr := false; (* We don't know if stderr is available *) - try Trace.log (message ^ "\n") + try Trace.log (title ^ ": " ^ message ^ "\n") with Util.Fatal _ -> () in (* Can't allow fatal errors in fatal error handler *) - let title = "Fatal error" in let toplevelWindow = try Some (toplevelWindow ()) with Util.Fatal err -> @@ -1657,9 +1657,9 @@ let createProfile parent = if React.state fat then Printf.fprintf ch "fat = true\n"; close_out ch); profileName := Some (React.state name) - with Sys_error _ as e -> + with Sys_error errmsg -> okBox ~parent:assistant ~typ:`ERROR ~title:"Could not save profile" - ~message:(Uicommon.exn2string e) + ~message:("Error when saving profile: " ^ errmsg) end; assistant#destroy (); in @@ -2400,9 +2400,9 @@ let editProfile parent name = false); close_out ch); setModified false - with Sys_error _ as e -> + with Sys_error errmsg -> okBox ~parent:t ~typ:`ERROR ~title:"Could not save profile" - ~message:(Uicommon.exn2string e) + ~message:("Error when saving profile: " ^ errmsg) end in let applyButton = diff --git a/src/uitext.ml b/src/uitext.ml index a2aaccf97..000104c7d 100644 --- a/src/uitext.ml +++ b/src/uitext.ml @@ -1585,7 +1585,10 @@ let handleException e = alwaysDisplay "\n"; Util.set_infos ""; restoreTerminal(); - let msg = Uicommon.exn2string e in + let lbl = + if e = Sys.Break then "" + else "Error: " in + let msg = lbl ^ Uicommon.exn2string e in let () = try Trace.log (msg ^ "\n") with Util.Fatal _ -> () in (* Can't allow fatal errors in fatal error handler *)