Make log mutex immune to raising logging functions (dbuenzli#57).

Author: dbuenzli

B0.ml

@@ -80,6 +80,9 @@ let test_multi =
 let test_threaded =
   test ~/"test/test_threaded.ml" ~requires:[logs_fmt; logs_threaded; threads]
 
+let test_mutext_safe =
+  test ~/"test/test_mutex_safe.ml" ~requires:[logs_fmt; logs_threaded; threads]
+
 let test_lwt =
   let requires = [b0_std; logs_fmt; logs_lwt; fmt; fmt_tty; lwt; lwt_unix] in
   test ~/"test/test_lwt.ml" ~requires

CHANGES.md

@@ -1,3 +1,8 @@
+
+
+* Make log mutex immune to raising logging functions.
+  Thanks to Nathan Taylor for the report and the repro (#57).
+
 v0.9.0 2025-07-08 Zagreb
 ------------------------
 

src/logs.ml

@@ -188,7 +188,11 @@ let report src level ~over k msgf =
   let mutex = Atomic.get reporter_mutex' in
   let over () = over (); mutex.unlock () in
   mutex.lock ();
-  (Atomic.get reporter').report src level ~over k msgf
+  try (Atomic.get reporter').report src level ~over k msgf with
+  | exn ->
+      let bt = Printexc.get_raw_backtrace ()  in
+      over ();
+      Printexc.raise_with_backtrace exn bt
 
 let pp_brackets pp_v ppf v =
   Format.pp_print_char ppf '['; pp_v ppf v; Format.pp_print_char ppf ']'

test/test_mutex_safe.ml

@@ -0,0 +1,25 @@
+(*---------------------------------------------------------------------------
+   Copyright (c) 2025 The logs programmers. All rights reserved.
+   SPDX-License-Identifier: ISC
+  ---------------------------------------------------------------------------*)
+
+(* See https://github.com/dbuenzli/logs/issues/57 *)
+
+let src = Logs.Src.create "repro case"
+module Log = (val Logs.src_log src)
+
+let setup_logs () =
+  Logs.set_reporter (Logs_fmt.reporter ());
+  Logs.set_level ~all:true (Some Logs.Debug);
+  Logs_threaded.enable ();
+  let m = Mutex.create () in
+  let lock () = Mutex.lock m and unlock () = Mutex.unlock m in
+  Logs.set_reporter_mutex ~lock ~unlock
+
+let main () =
+  setup_logs ();
+  (try Logs.app (fun _m -> failwith "uh oh...") with Failure _ -> ());
+  Logs.app (fun m -> m "It works!");
+  0
+
+let () = if !Sys.interactive then () else exit (main ())