[thread] protect threads against sigalrm

This makes the implementation of Timeout on unix more reliable
since only the main thread will receive the signal for
timeout.

1 files changed, 7 insertions, 0 deletions

diff --git a/clib/cThread.ml b/clib/cThread.ml
index 0b7955aa28..c50768b88d 100644
--- a/clib/cThread.ml
+++ b/clib/cThread.ml
@@ -97,3 +97,10 @@ let thread_friendly_input_value ic =
     end
   with Unix.Unix_error _ | Sys_error _ -> raise End_of_file
 
+let protect_sigalrm f x =
+  begin try ignore(Thread.sigmask Unix.SIG_BLOCK [Sys.sigalrm])
+  with Invalid_argument _ -> () end;
+  f x
+
+let create f x =
+  Thread.create (protect_sigalrm f) x