Introduce the Thread.Exit exception

Changes

@@ -149,6 +149,11 @@ OCaml 4.14.0
   WSADuplicateSocket on sockets instead of DuplicateHandle.
   (Antonin Décimo, review by Xavier Leroy and Nicolás Ojeda Bär)
 
+- #10951: Introduce the Thread.Exit exception as an alternative way to
+  terminate threads prematurely.  This alternative way will become
+  the standard way in 5.00.
+  (Xavier Leroy, review by Florian Angeletti)
+
 ### Tools:
 
 - #3959, #7202, #10476: ocaml, in script mode, directive errors

otherlibs/systhreads/thread.ml

@@ -40,18 +40,25 @@ let uncaught_exception_handler = ref default_uncaught_exception_handler
 
 let set_uncaught_exception_handler fn = uncaught_exception_handler := fn
 
+exception Exit
+
 let create fn arg =
   thread_new
     (fun () ->
       try
         fn arg;
         ignore (Sys.opaque_identity (check_memprof_cb ()))
-      with exn ->
+      with
+      | Exit ->
+        ignore (Sys.opaque_identity (check_memprof_cb ()))
+      | exn ->
         let raw_backtrace = Printexc.get_raw_backtrace () in
         flush stdout; flush stderr;
         try
           !uncaught_exception_handler exn
-        with exn' ->
+        with
+        | Exit -> ()
+        | exn' ->
           Printf.eprintf
             "Thread %d killed on uncaught exception %s\n"
             (id (self ())) (Printexc.to_string exn);

otherlibs/systhreads/thread.mli

@@ -27,8 +27,9 @@ val create : ('a -> 'b) -> 'a -> t
    The application of [Thread.create]
    returns the handle of the newly created thread.
    The new thread terminates when the application [funct arg]
-   returns, either normally or by raising an uncaught exception.
-   In the latter case, the exception is printed on standard error,
+   returns, either normally or by raising the {!Thread.Exit} exception
+   or by raising any other uncaught exception.
+   In the last case, the uncaught exception is printed on standard error,
    but not propagated back to the parent thread. Similarly, the
    result of the application [funct arg] is discarded and not
    directly accessible to the parent thread. *)
@@ -41,6 +42,17 @@ val id : t -> int
    is an integer that identifies uniquely the thread.
    It can be used to build data structures indexed by threads. *)
 
+exception Exit
+(** Exception that can be raised by user code to initiate termination
+    of the current thread.
+    Compared to calling the {!Thread.exit} function, raising the
+    {!Thread.Exit} exception will trigger {!Fun.finally} finalizers
+    and catch-all exception handlers.
+    It is the recommended way to terminate threads prematurely.
+
+    @since 4.14.0
+*)
+
 val exit : unit -> unit
 (** Terminate prematurely the currently executing thread. *)
 

testsuite/tests/backtrace/callstack.reference

@@ -12,4 +12,4 @@ Raised by primitive operation at Callstack.f0 in file "callstack.ml", line 11, c
 Called from Callstack.f1 in file "callstack.ml", line 12, characters 27-32
 Called from Callstack.f2 in file "callstack.ml", line 13, characters 27-32
 Called from Callstack.f3 in file "callstack.ml", line 14, characters 27-32
-Called from Thread.create.(fun) in file "thread.ml", line 47, characters 8-14
+Called from Thread.create.(fun) in file "thread.ml", line 49, characters 8-14

testsuite/tests/lib-threads/uncaught_exception_handler.ml

@@ -17,13 +17,13 @@ let () = Printexc.record_backtrace true
 exception UncaughtHandlerExn
 exception CallbackExn
 
-let handler exn =
+let handler final_exn exn =
   let id = Thread.self () |> Thread.id in
   let msg = Printexc.to_string exn in
   Printf.eprintf "[thread %d] caught %s\n" id msg;
   Printexc.print_backtrace stderr;
   flush stderr;
-  raise UncaughtHandlerExn
+  raise final_exn
 
 let fn () = Printexc.raise_with_backtrace
               CallbackExn
@@ -32,6 +32,9 @@ let fn () = Printexc.raise_with_backtrace
 let _ =
   let th = Thread.create fn () in
   Thread.join th;
-  Thread.set_uncaught_exception_handler handler;
+  Thread.set_uncaught_exception_handler (handler UncaughtHandlerExn);
+  let th = Thread.create fn () in
+  Thread.join th;
+  Thread.set_uncaught_exception_handler (handler Thread.Exit);
   let th = Thread.create fn () in
   Thread.join th

testsuite/tests/lib-threads/uncaught_exception_handler.reference

@@ -1,12 +1,15 @@
 Thread 1 killed on uncaught exception Uncaught_exception_handler.CallbackExn
 Raised at Uncaught_exception_handler.fn in file "uncaught_exception_handler.ml", line 28, characters 12-113
-Called from Thread.create.(fun) in file "thread.ml", line 47, characters 8-14
+Called from Thread.create.(fun) in file "thread.ml", line 49, characters 8-14
 [thread 2] caught Uncaught_exception_handler.CallbackExn
 Raised at Uncaught_exception_handler.fn in file "uncaught_exception_handler.ml", line 28, characters 12-113
-Called from Thread.create.(fun) in file "thread.ml", line 47, characters 8-14
+Called from Thread.create.(fun) in file "thread.ml", line 49, characters 8-14
 Thread 2 killed on uncaught exception Uncaught_exception_handler.CallbackExn
 Raised at Uncaught_exception_handler.fn in file "uncaught_exception_handler.ml", line 28, characters 12-113
-Called from Thread.create.(fun) in file "thread.ml", line 47, characters 8-14
+Called from Thread.create.(fun) in file "thread.ml", line 49, characters 8-14
 Thread 2 uncaught exception handler raised Uncaught_exception_handler.UncaughtHandlerExn
-Raised at Uncaught_exception_handler.handler in file "uncaught_exception_handler.ml", line 26, characters 2-26
-Called from Thread.create.(fun) in file "thread.ml", line 53, characters 10-41
+Raised at Uncaught_exception_handler.handler in file "uncaught_exception_handler.ml", line 26, characters 2-17
+Called from Thread.create.(fun) in file "thread.ml", line 58, characters 10-41
+[thread 3] caught Uncaught_exception_handler.CallbackExn
+Raised at Uncaught_exception_handler.fn in file "uncaught_exception_handler.ml", line 28, characters 12-113
+Called from Thread.create.(fun) in file "thread.ml", line 49, characters 8-14