Add exception handler to run_in_main_dont_wait

Author: raphael-proust

src/unix/lwt_preemptive.ml

@@ -258,3 +258,9 @@ let run_in_main f =
   match CELL.get cell with
   | Result.Ok ret -> ret
   | Result.Error exn -> raise exn
+
+(* This version shadows the one above, adding an exception handler *)
+let run_in_main_dont_wait f handler =
+  let f () = Lwt.catch f (fun exc -> handler exc; Lwt.return_unit) in
+  run_in_main_dont_wait f
+

src/unix/lwt_preemptive.mli

@@ -34,10 +34,13 @@ val run_in_main : (unit -> 'a Lwt.t) -> 'a
       retrieve values set this way inside [f ()], but not values set using
       {!Lwt.with_value} outside [f ()]. *)
 
-val run_in_main_dont_wait : (unit -> unit Lwt.t) -> unit
-(** [run_in_main_dont_wait f] does the same as [run_in_main f] but a bit faster
+val run_in_main_dont_wait : (unit -> unit Lwt.t) -> (exn -> unit) -> unit
+(** [run_in_main_dont_wait f h] does the same as [run_in_main f] but a bit faster
     and lighter as it does not wait for the result of [f].
 
+    If [f]'s promise is rejected (or if it raises), then the function [h] is
+    called with the rejection exception.
+
     @since 5.7.0 *)
 
 val init : int -> int -> (string -> unit) -> unit

test/unix/test_lwt_unix.ml

@@ -1066,16 +1066,32 @@ let lwt_preemptive_tests = [
   test "run_in_main_dont_wait" begin fun () ->
     let p, r = Lwt.wait () in
     let f () =
-      Lwt_preemptive.run_in_main_dont_wait (fun () ->
-        Lwt.pause () >>= fun () ->
-        Lwt.pause () >>= fun () ->
-        Lwt.wakeup r 42;
-        Lwt.return ())
+      Lwt_preemptive.run_in_main_dont_wait
+        (fun () ->
+          Lwt.pause () >>= fun () ->
+          Lwt.pause () >>= fun () ->
+          Lwt.wakeup r 42;
+          Lwt.return ())
+        (fun _ -> assert false)
     in
     Lwt_preemptive.detach f () >>= fun () ->
     p >>= fun x ->
     Lwt.return (x = 42)
   end;
+  test "run_in_main_dont_wait_fail" begin fun () ->
+    let p, r = Lwt.wait () in
+    let f () =
+      Lwt_preemptive.run_in_main_dont_wait
+        (fun () ->
+          Lwt.pause () >>= fun () ->
+          Lwt.pause () >>= fun () ->
+          raise Exit)
+        (function Exit -> Lwt.wakeup r 45 | _ -> assert false)
+    in
+    Lwt_preemptive.detach f () >>= fun () ->
+    p >>= fun x ->
+    Lwt.return (x = 45)
+  end;
   test "run_in_main_with_dont_wait" begin fun () ->
     let p, r = Lwt.wait () in
     let f () =