diff options
| author | Emilio Jesus Gallego Arias | 2019-01-24 14:25:09 +0100 |
|---|---|---|
| committer | Emilio Jesus Gallego Arias | 2019-01-24 14:25:09 +0100 |
| commit | ea6c157e7a47039d2c1505e896dbdd099a0da450 (patch) | |
| tree | 6bf2035eee82d12be341602edb3653991399cb07 /clib | |
| parent | f5241b99bb15f019eb629a7f24f2993f011e7e06 (diff) | |
| parent | aa4f1346e7cf2f8424259143d7aca6a883d3f9d2 (diff) | |
Merge PR #9372: [thread] protect threads against sigalrm
Reviewed-by: ejgallego
Diffstat (limited to 'clib')
| -rw-r--r-- | clib/cThread.ml | 10 | ||||
| -rw-r--r-- | clib/cThread.mli | 3 |
2 files changed, 13 insertions, 0 deletions
diff --git a/clib/cThread.ml b/clib/cThread.ml index 0b7955aa28..9e0319e8f8 100644 --- a/clib/cThread.ml +++ b/clib/cThread.ml @@ -97,3 +97,13 @@ let thread_friendly_input_value ic = end with Unix.Unix_error _ | Sys_error _ -> raise End_of_file +(* On the ocaml runtime used in some opam-for-windows version the + * [Thread.sigmask] API raises Invalid_argument "not implemented", + * hence we protect the call and turn the exception into a no-op *) +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 diff --git a/clib/cThread.mli b/clib/cThread.mli index acc5a60c09..b090479c4c 100644 --- a/clib/cThread.mli +++ b/clib/cThread.mli @@ -26,3 +26,6 @@ val thread_friendly_really_read : thread_ic -> Bytes.t -> off:int -> len:int -> unit val thread_friendly_really_read_line : thread_ic -> string +(* Wrapper around Thread.create that blocks signals such as Sys.sigalrm (used + * for Timeout *) +val create : ('a -> 'b) -> 'a -> Thread.t |