From 2f1edec71a18da14b53d14eedf3dc9b4c940eb8c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rapha=C3=ABl=20Proust?= <code@bnwr.net>
Date: Fri, 3 Mar 2023 11:11:46 +0100
Subject: [PATCH] Make exception filtering optional

---
 CHANGES                          |  1 +
 src/core/lwt.ml                  | 66 +++++++++++++++++---------------
 src/core/lwt.mli                 | 34 +++++++++++++++-
 src/core/lwt_seq.ml              |  6 +--
 src/react/lwt_react.ml           |  2 +-
 src/unix/lwt_io.ml               |  2 +-
 src/unix/lwt_main.ml             |  2 +-
 src/unix/lwt_preemptive.ml       |  2 +-
 src/unix/lwt_timeout.ml          |  2 +-
 src/unix/lwt_unix.cppo.ml        | 14 +++----
 test/core/test_lwt.ml            |  4 ++
 test/unix/ocaml_runtime_exc_1.ml |  3 ++
 test/unix/ocaml_runtime_exc_2.ml |  3 ++
 test/unix/ocaml_runtime_exc_3.ml |  3 ++
 test/unix/ocaml_runtime_exc_4.ml |  3 ++
 test/unix/ocaml_runtime_exc_5.ml |  3 ++
 test/unix/ocaml_runtime_exc_6.ml |  3 ++
 17 files changed, 106 insertions(+), 47 deletions(-)

diff --git a/CHANGES b/CHANGES
index cb8d888fd..53225c999 100644
--- a/CHANGES
+++ b/CHANGES
@@ -18,6 +18,7 @@
 
 ====== Additions ======
 
+  * Lwt.set_exception_filter for enabling/disabling system-exception catching (#964)
   * Lwt.reraise an exception raising function which preserves backtraces, recommended for use in Lwt.catch (#963)
   * Expose Lwt_io.delete_recursively for deleting a directory and its content recursively. (#984, Antonin Décimo)
 
diff --git a/src/core/lwt.ml b/src/core/lwt.ml
index fc6498bbb..a61c815bd 100644
--- a/src/core/lwt.ml
+++ b/src/core/lwt.ml
@@ -710,12 +710,18 @@ struct
 end
 open Basic_helpers
 
-
-(* Small helper function to avoid catching ocaml-runtime exceptions *)
-let is_not_ocaml_runtime_exception = function
+(* Small helpers to avoid catching ocaml-runtime exceptions *)
+type exception_filter = exn -> bool
+let catch_all_filter = fun _ -> true
+let catch_not_runtime_filter = function
   | Out_of_memory -> false
   | Stack_overflow -> false
   | _ -> true
+let exception_filter =
+  (* Default value: the legacy behaviour to avoid breaking programs *)
+  ref catch_all_filter
+let set_exception_filter f = exception_filter := f
+let filter_exception e = !exception_filter e
 
 module Sequence_associated_storage :
 sig
@@ -796,7 +802,7 @@ struct
       let result = f () in
       current_storage := saved_storage;
       result
-    with exn when is_not_ocaml_runtime_exception exn ->
+    with exn when !exception_filter exn ->
       current_storage := saved_storage;
       raise exn
 end
@@ -1134,7 +1140,7 @@ struct
        be reject later, it is not the responsibility of this function to pass
        the exception to [!async_exception_hook]. *)
     try f v
-    with exn when is_not_ocaml_runtime_exception exn ->
+    with exn when !exception_filter exn ->
       !async_exception_hook exn
 
 
@@ -1834,7 +1840,7 @@ struct
 
           let p' =
             try f v with exn
-            when is_not_ocaml_runtime_exception exn -> fail exn
+            when !exception_filter exn -> fail exn
           in
           let Internal p' = to_internal_promise p' in
           (* Run the user's function [f]. *)
@@ -1900,7 +1906,7 @@ struct
 
           let p' =
             try f v
-            with exn when is_not_ocaml_runtime_exception exn ->
+            with exn when !exception_filter exn ->
               fail (add_loc exn) in
           let Internal p' = to_internal_promise p' in
 
@@ -1957,7 +1963,7 @@ struct
 
           let p''_result =
             try Fulfilled (f v) with exn
-            when is_not_ocaml_runtime_exception exn -> Rejected exn
+            when !exception_filter exn -> Rejected exn
           in
 
           let State_may_now_be_pending_proxy p'' = may_now_be_proxy p'' in
@@ -1987,7 +1993,7 @@ struct
           to_public_promise
             {state =
               try Fulfilled (f v)
-              with exn when is_not_ocaml_runtime_exception exn -> Rejected exn})
+              with exn when !exception_filter exn -> Rejected exn})
         ~if_deferred:(fun () ->
           let (p'', callback) =
             create_result_promise_and_callback_if_deferred () in
@@ -2006,7 +2012,7 @@ struct
   let catch f h =
     let p =
       try f ()
-      with exn when is_not_ocaml_runtime_exception exn -> fail exn
+      with exn when !exception_filter exn -> fail exn
     in
     let Internal p = to_internal_promise p in
     let p = underlying p in
@@ -2031,7 +2037,7 @@ struct
 
           let p' =
             try h exn
-            with exn when is_not_ocaml_runtime_exception exn -> fail exn
+            with exn when !exception_filter exn -> fail exn
           in
           let Internal p' = to_internal_promise p' in
 
@@ -2067,7 +2073,7 @@ struct
   let backtrace_catch add_loc f h =
     let p =
       try f ()
-      with exn when is_not_ocaml_runtime_exception exn -> fail exn
+      with exn when !exception_filter exn -> fail exn
     in
     let Internal p = to_internal_promise p in
     let p = underlying p in
@@ -2092,7 +2098,7 @@ struct
 
           let p' =
             try h exn
-            with exn when is_not_ocaml_runtime_exception exn ->
+            with exn when !exception_filter exn ->
               fail (add_loc exn)
           in
           let Internal p' = to_internal_promise p' in
@@ -2129,7 +2135,7 @@ struct
   let try_bind f f' h =
     let p =
       try f ()
-      with exn when is_not_ocaml_runtime_exception exn -> fail exn
+      with exn when !exception_filter exn -> fail exn
     in
     let Internal p = to_internal_promise p in
     let p = underlying p in
@@ -2146,7 +2152,7 @@ struct
 
           let p' =
             try f' v
-            with exn when is_not_ocaml_runtime_exception exn -> fail exn
+            with exn when !exception_filter exn -> fail exn
           in
           let Internal p' = to_internal_promise p' in
 
@@ -2162,7 +2168,7 @@ struct
 
           let p' =
             try h exn
-            with exn when is_not_ocaml_runtime_exception exn -> fail exn
+            with exn when !exception_filter exn -> fail exn
           in
           let Internal p' = to_internal_promise p' in
 
@@ -2204,7 +2210,7 @@ struct
   let backtrace_try_bind add_loc f f' h =
     let p =
       try f ()
-      with exn when is_not_ocaml_runtime_exception exn -> fail exn
+      with exn when !exception_filter exn -> fail exn
     in
     let Internal p = to_internal_promise p in
     let p = underlying p in
@@ -2221,7 +2227,7 @@ struct
 
           let p' =
             try f' v
-            with exn when is_not_ocaml_runtime_exception exn ->
+            with exn when !exception_filter exn ->
               fail (add_loc exn)
           in
           let Internal p' = to_internal_promise p' in
@@ -2238,7 +2244,7 @@ struct
 
           let p' =
             try h exn
-            with exn when is_not_ocaml_runtime_exception exn ->
+            with exn when !exception_filter exn ->
               fail (add_loc exn)
           in
           let Internal p' = to_internal_promise p' in
@@ -2493,7 +2499,7 @@ struct
   let dont_wait f h =
     let p =
       try f ()
-      with exn when is_not_ocaml_runtime_exception exn -> fail exn
+      with exn when !exception_filter exn -> fail exn
     in
     let Internal p = to_internal_promise p in
 
@@ -2516,7 +2522,7 @@ struct
   let async f =
     let p =
       try f ()
-      with exn when is_not_ocaml_runtime_exception exn -> fail exn
+      with exn when !exception_filter exn -> fail exn
     in
     let Internal p = to_internal_promise p in
 
@@ -3119,39 +3125,39 @@ struct
 
 
   let apply f x =
-    try f x with exn when is_not_ocaml_runtime_exception exn -> fail exn
+    try f x with exn when !exception_filter exn -> fail exn
 
   let wrap f =
     try return (f ())
-    with exn when is_not_ocaml_runtime_exception exn -> fail exn
+    with exn when !exception_filter exn -> fail exn
 
   let wrap1 f x1 =
     try return (f x1)
-    with exn when is_not_ocaml_runtime_exception exn -> fail exn
+    with exn when !exception_filter exn -> fail exn
 
   let wrap2 f x1 x2 =
     try return (f x1 x2)
-    with exn when is_not_ocaml_runtime_exception exn -> fail exn
+    with exn when !exception_filter exn -> fail exn
 
   let wrap3 f x1 x2 x3 =
     try return (f x1 x2 x3)
-    with exn when is_not_ocaml_runtime_exception exn -> fail exn
+    with exn when !exception_filter exn -> fail exn
 
   let wrap4 f x1 x2 x3 x4 =
     try return (f x1 x2 x3 x4)
-    with exn when is_not_ocaml_runtime_exception exn -> fail exn
+    with exn when !exception_filter exn -> fail exn
 
   let wrap5 f x1 x2 x3 x4 x5 =
     try return (f x1 x2 x3 x4 x5)
-    with exn when is_not_ocaml_runtime_exception exn -> fail exn
+    with exn when !exception_filter exn -> fail exn
 
   let wrap6 f x1 x2 x3 x4 x5 x6 =
     try return (f x1 x2 x3 x4 x5 x6)
-    with exn when is_not_ocaml_runtime_exception exn -> fail exn
+    with exn when !exception_filter exn -> fail exn
 
   let wrap7 f x1 x2 x3 x4 x5 x6 x7 =
     try return (f x1 x2 x3 x4 x5 x6 x7)
-    with exn when is_not_ocaml_runtime_exception exn -> fail exn
+    with exn when !exception_filter exn -> fail exn
 
 
 
diff --git a/src/core/lwt.mli b/src/core/lwt.mli
index 0b1e7407c..41edb973f 100644
--- a/src/core/lwt.mli
+++ b/src/core/lwt.mli
@@ -1999,6 +1999,36 @@ val ignore_result : _ t -> unit
       resolved, completing any associated side effects along the way. In fact,
       the function that does {e that} is ordinary {!Lwt.bind}. *)
 
+(** {4 Runtime exception filters}
+
+    Depending on the kind of programs that you write, you may need to treat
+    exceptions thrown by the OCaml runtime (namely [Out_of_memory] and
+    [Stack_overflow] differently. This is because (a) these exceptions are not
+    reproducible (in that they are thrown at different points of your program
+    depending on the machine that your program runs on) and (b) recovering
+    from these errors may be impossible.
+
+    The helpers below allow you to change the way that Lwt handles the two OCaml
+    runtime exceptions [Out_of_memory] and [Stack_overflow]. *)
+
+(** An [exception_filter] is a value which indicates to Lwt what exceptions to
+    catch and what exceptions to let bubble up all the way out of the main loop
+    immediately. *)
+type exception_filter
+
+(** [catch_all_filter] is the default filter. With it the all the exceptions
+    (including [Out_of_memory] and [Stack_overflow]) are caught and transformed
+    into rejected promises. *)
+val catch_all_filter : exception_filter
+
+(** [catch_not_runtime_filter] is a filter which lets the OCaml runtime
+    exceptions ([Out_of_memory] and [Stack_overflow]) go through all the Lwt
+    abstractions and bubble all the way out of the call to [Lwt_main.run]. *)
+val catch_not_runtime_filter : exception_filter
+
+(** [set_exception_filter] sets the given exception filter globally. *)
+val set_exception_filter : exception_filter -> unit
+
 
 
 (**/**)
@@ -2006,8 +2036,6 @@ val ignore_result : _ t -> unit
 val poll : 'a t -> 'a option
 val apply : ('a -> 'b t) -> 'a -> 'b t
 
-val is_not_ocaml_runtime_exception : exn -> bool
-
 val backtrace_bind :
   (exn -> exn) -> 'a t -> ('a -> 'b t) -> 'b t
 val backtrace_catch :
@@ -2020,3 +2048,5 @@ val backtrace_try_bind :
 val abandon_wakeups : unit -> unit
 
 val debug_state_is : 'a state -> 'a t -> bool t
+
+val filter_exception : exn -> bool
diff --git a/src/core/lwt_seq.ml b/src/core/lwt_seq.ml
index d336a811f..c398f3e3a 100644
--- a/src/core/lwt_seq.ml
+++ b/src/core/lwt_seq.ml
@@ -270,7 +270,7 @@ let rec unfold f u () =
   match f u with
   | None -> return_nil
   | Some (x, u') -> Lwt.return (Cons (x, unfold f u'))
-  | exception exc when Lwt.is_not_ocaml_runtime_exception exc -> Lwt.fail exc
+  | exception exc when Lwt.filter_exception exc -> Lwt.fail exc
 
 let rec unfold_lwt f u () =
   let* x = f u in
@@ -305,7 +305,7 @@ let rec of_seq seq () =
   | Seq.Nil -> return_nil
   | Seq.Cons (x, next) ->
     Lwt.return (Cons (x, (of_seq next)))
-  | exception exn when Lwt.is_not_ocaml_runtime_exception exn -> Lwt.fail exn
+  | exception exn when Lwt.filter_exception exn -> Lwt.fail exn
 
 let rec of_seq_lwt (seq: 'a Lwt.t Seq.t): 'a t = fun () ->
     match seq () with
@@ -321,4 +321,4 @@ let of_seq_lwt (seq: 'a Lwt.t Seq.t): 'a t = fun () ->
        let+ x = x in
        let next = of_seq_lwt next in
        Cons (x, next)
-    | exception exc when Lwt.is_not_ocaml_runtime_exception exc -> Lwt.fail exc
+    | exception exc when Lwt.filter_exception exc -> Lwt.fail exc
diff --git a/src/react/lwt_react.ml b/src/react/lwt_react.ml
index 16b541c2f..5c7061097 100644
--- a/src/react/lwt_react.ml
+++ b/src/react/lwt_react.ml
@@ -98,7 +98,7 @@ module E = struct
       Lwt_stream.iter
         (fun v ->
           try push v
-          with exn when Lwt.is_not_ocaml_runtime_exception exn ->
+          with exn when Lwt.filter_exception exn ->
             !Lwt.async_exception_hook exn)
         stream in
     with_finaliser (cancel_thread t) event
diff --git a/src/unix/lwt_io.ml b/src/unix/lwt_io.ml
index a33274a58..fb02ca733 100644
--- a/src/unix/lwt_io.ml
+++ b/src/unix/lwt_io.ml
@@ -537,7 +537,7 @@ let make :
         perform_io,
         fun pos cmd ->
           try seek pos cmd
-          with e when Lwt.is_not_ocaml_runtime_exception e -> Lwt.fail e
+          with e when Lwt.filter_exception e -> Lwt.fail e
     );
   } and wrapper = {
     state = Idle;
diff --git a/src/unix/lwt_main.ml b/src/unix/lwt_main.ml
index 068b7b570..eaf01751c 100644
--- a/src/unix/lwt_main.ml
+++ b/src/unix/lwt_main.ml
@@ -119,7 +119,7 @@ let run p =
   | result ->
     finished ();
     result
-  | exception exn when Lwt.is_not_ocaml_runtime_exception exn ->
+  | exception exn when Lwt.filter_exception exn ->
     finished ();
     raise exn
 
diff --git a/src/unix/lwt_preemptive.ml b/src/unix/lwt_preemptive.ml
index cb60ca83e..0ea595217 100644
--- a/src/unix/lwt_preemptive.ml
+++ b/src/unix/lwt_preemptive.ml
@@ -182,7 +182,7 @@ let detach f args =
   let task () =
     try
       result := Result.Ok (f args)
-    with exn when Lwt.is_not_ocaml_runtime_exception exn ->
+    with exn when Lwt.filter_exception exn ->
       result := Result.Error exn
   in
   get_worker () >>= fun worker ->
diff --git a/src/unix/lwt_timeout.ml b/src/unix/lwt_timeout.ml
index dea9cfda9..ed7211bf4 100644
--- a/src/unix/lwt_timeout.ml
+++ b/src/unix/lwt_timeout.ml
@@ -72,7 +72,7 @@ let rec loop () =
       (*XXX Should probably report any exception *)
       try
         x.action ()
-      with e when Lwt.is_not_ocaml_runtime_exception e ->
+      with e when Lwt.filter_exception e ->
         !handle_exn e
     done;
     curr := (!curr + 1) mod (Array.length !buckets);
diff --git a/src/unix/lwt_unix.cppo.ml b/src/unix/lwt_unix.cppo.ml
index b0c508c23..b185d9717 100644
--- a/src/unix/lwt_unix.cppo.ml
+++ b/src/unix/lwt_unix.cppo.ml
@@ -184,7 +184,7 @@ let wait_for_jobs () =
 let wrap_result f x =
   try
     Result.Ok (f x)
-  with exn when Lwt.is_not_ocaml_runtime_exception exn ->
+  with exn when Lwt.filter_exception exn ->
     Result.Error exn
 
 let run_job_aux async_method job result =
@@ -244,7 +244,7 @@ external run_job_sync : 'a job -> 'a = "lwt_unix_run_job_sync"
 let self_result job =
   try
     Result.Ok (self_result job)
-  with exn when Lwt.is_not_ocaml_runtime_exception exn ->
+  with exn when Lwt.filter_exception exn ->
     Result.Error exn
 
 let in_retention_test = ref false
@@ -267,7 +267,7 @@ let run_job ?async_method job =
   if async_method = Async_none then
     try
       Lwt.return (run_job_sync job)
-    with exn when Lwt.is_not_ocaml_runtime_exception exn ->
+    with exn when Lwt.filter_exception exn ->
       Lwt.fail exn
   else
     run_job_aux async_method job self_result
@@ -519,7 +519,7 @@ let rec retry_syscall node event ch wakener action =
       Requeued Read
     | Retry_write ->
       Requeued Write
-    | e when Lwt.is_not_ocaml_runtime_exception e ->
+    | e when Lwt.filter_exception e ->
       Exn e
   in
   match res with
@@ -581,7 +581,7 @@ let wrap_syscall event ch action =
     register_action Read ch action
   | Retry_write ->
     register_action Write ch action
-  | e when Lwt.is_not_ocaml_runtime_exception e ->
+  | e when Lwt.filter_exception e ->
     Lwt.fail e
 
 (* +-----------------------------------------------------------------+
@@ -2265,7 +2265,7 @@ let on_signal_full signum handler =
       in
       (try
          set_signal signum notification
-       with exn when Lwt.is_not_ocaml_runtime_exception exn ->
+       with exn when Lwt.filter_exception exn ->
          stop_notification notification;
          raise exn);
       signals := Signal_map.add signum (notification, actions) !signals;
@@ -2369,7 +2369,7 @@ let install_sigchld_handler () =
                  Lwt_sequence.remove node;
                  Lwt.wakeup wakener v
                end
-             with e when Lwt.is_not_ocaml_runtime_exception e ->
+             with e when Lwt.filter_exception e ->
                Lwt_sequence.remove node;
                Lwt.wakeup_exn wakener e
            end wait_children)
diff --git a/test/core/test_lwt.ml b/test/core/test_lwt.ml
index 195715d6b..6ed07aae1 100644
--- a/test/core/test_lwt.ml
+++ b/test/core/test_lwt.ml
@@ -636,7 +636,9 @@ let catch_tests = suite "catch" [
     p4
   end;
 
+
   test "catch with ocaml-runtime exception" begin fun () ->
+    Lwt.set_exception_filter Lwt.catch_not_runtime_filter;
     try
       Lwt.catch
         (fun () -> raise Out_of_memory)
@@ -646,6 +648,7 @@ let catch_tests = suite "catch" [
   end;
 
   test "try_bind with ocaml-runtime exception" begin fun () ->
+    Lwt.set_exception_filter Lwt.catch_not_runtime_filter;
     try
       Lwt.try_bind
         (fun () -> raise Out_of_memory)
@@ -656,6 +659,7 @@ let catch_tests = suite "catch" [
   end;
 
   test "try_bind(2) with ocaml-runtime exception" begin fun () ->
+    Lwt.set_exception_filter Lwt.catch_not_runtime_filter;
     try
       let _ =
         Lwt.try_bind
diff --git a/test/unix/ocaml_runtime_exc_1.ml b/test/unix/ocaml_runtime_exc_1.ml
index bf902de7b..76ff65596 100644
--- a/test/unix/ocaml_runtime_exc_1.ml
+++ b/test/unix/ocaml_runtime_exc_1.ml
@@ -1,6 +1,9 @@
 (* This file is part of Lwt, released under the MIT license. See LICENSE.md for
    details, or visit https://github.com/ocsigen/lwt/blob/master/LICENSE.md. *)
 
+(* set the exception filter being tested *)
+let () = Lwt.set_exception_filter Lwt.catch_not_runtime_filter
+
 (* OCaml runtime exceptions (out-of-memory, stack-overflow) are fatal in a
    different way than other exceptions and they leave the Lwt main loop in an
    inconsistent state where it cannot be restarted. Indeed, attempting to call
diff --git a/test/unix/ocaml_runtime_exc_2.ml b/test/unix/ocaml_runtime_exc_2.ml
index 474331b91..83a2f158e 100644
--- a/test/unix/ocaml_runtime_exc_2.ml
+++ b/test/unix/ocaml_runtime_exc_2.ml
@@ -1,6 +1,9 @@
 (* This file is part of Lwt, released under the MIT license. See LICENSE.md for
    details, or visit https://github.com/ocsigen/lwt/blob/master/LICENSE.md. *)
 
+(* set the exception filter being tested *)
+let () = Lwt.set_exception_filter Lwt.catch_not_runtime_filter
+
 (* OCaml runtime exceptions (out-of-memory, stack-overflow) are fatal in a
    different way than other exceptions and they leave the Lwt main loop in an
    inconsistent state where it cannot be restarted. Indeed, attempting to call
diff --git a/test/unix/ocaml_runtime_exc_3.ml b/test/unix/ocaml_runtime_exc_3.ml
index 76df14d19..beed6611d 100644
--- a/test/unix/ocaml_runtime_exc_3.ml
+++ b/test/unix/ocaml_runtime_exc_3.ml
@@ -1,6 +1,9 @@
 (* This file is part of Lwt, released under the MIT license. See LICENSE.md for
    details, or visit https://github.com/ocsigen/lwt/blob/master/LICENSE.md. *)
 
+(* set the exception filter being tested *)
+let () = Lwt.set_exception_filter Lwt.catch_not_runtime_filter
+
 (* OCaml runtime exceptions (out-of-memory, stack-overflow) are fatal in a
    different way than other exceptions and they leave the Lwt main loop in an
    inconsistent state where it cannot be restarted. Indeed, attempting to call
diff --git a/test/unix/ocaml_runtime_exc_4.ml b/test/unix/ocaml_runtime_exc_4.ml
index 29ffef935..6ba480ba1 100644
--- a/test/unix/ocaml_runtime_exc_4.ml
+++ b/test/unix/ocaml_runtime_exc_4.ml
@@ -1,6 +1,9 @@
 (* This file is part of Lwt, released under the MIT license. See LICENSE.md for
    details, or visit https://github.com/ocsigen/lwt/blob/master/LICENSE.md. *)
 
+(* set the exception filter being tested *)
+let () = Lwt.set_exception_filter Lwt.catch_not_runtime_filter
+
 (* OCaml runtime exceptions (out-of-memory, stack-overflow) are fatal in a
    different way than other exceptions and they leave the Lwt main loop in an
    inconsistent state where it cannot be restarted. Indeed, attempting to call
diff --git a/test/unix/ocaml_runtime_exc_5.ml b/test/unix/ocaml_runtime_exc_5.ml
index 185d99a98..99f2814e3 100644
--- a/test/unix/ocaml_runtime_exc_5.ml
+++ b/test/unix/ocaml_runtime_exc_5.ml
@@ -1,6 +1,9 @@
 (* This file is part of Lwt, released under the MIT license. See LICENSE.md for
    details, or visit https://github.com/ocsigen/lwt/blob/master/LICENSE.md. *)
 
+(* set the exception filter being tested *)
+let () = Lwt.set_exception_filter Lwt.catch_not_runtime_filter
+
 (* OCaml runtime exceptions (out-of-memory, stack-overflow) are fatal in a
    different way than other exceptions and they leave the Lwt main loop in an
    inconsistent state where it cannot be restarted. Indeed, attempting to call
diff --git a/test/unix/ocaml_runtime_exc_6.ml b/test/unix/ocaml_runtime_exc_6.ml
index c9069fafe..6123d76fa 100644
--- a/test/unix/ocaml_runtime_exc_6.ml
+++ b/test/unix/ocaml_runtime_exc_6.ml
@@ -1,6 +1,9 @@
 (* This file is part of Lwt, released under the MIT license. See LICENSE.md for
    details, or visit https://github.com/ocsigen/lwt/blob/master/LICENSE.md. *)
 
+(* set the exception filter being tested *)
+let () = Lwt.set_exception_filter Lwt.catch_not_runtime_filter
+
 (* OCaml runtime exceptions (out-of-memory, stack-overflow) are fatal in a
    different way than other exceptions and they leave the Lwt main loop in an
    inconsistent state where it cannot be restarted. Indeed, attempting to call