threads, signals, and timeout

[yoann padioleau <pad.aryx@gmail.com>]

Hi,

I would like to create different threads where each thread do some
computation and are subject to different
timeout. Without threads I usually use Unix.alarm with a SIGALARM
handler that just raise a Timeout exception
and everything works fine, but when I try to do something similar with
threads it does not work
because apparently the Unix.alarm done in one thread override the
Unix.alarm done in another
thread. I had a look at thread.mli but was not able to find anything
related to timeout.
Is there a way to have multiple timeout and multiple threads at the same time ?

Here is a program that unforunately get the first timeout, but not the second :(


(*
ocamlc -g -thread unix.cma threads.cma signals_and_threads.ml
*)

exception Timeout

let mytid () =
  let t = Thread.self () in
  let i = Thread.id t in
  i

let set_timeout () =

  Sys.set_signal Sys.sigalrm
    (Sys.Signal_handle (fun _ ->
      prerr_endline "Time is up!";
      print_string (Printf.sprintf "id: %d\n" (mytid()));
      raise Timeout
    ));

  ignore(Unix.alarm 1);
  ()


let main =
  let t1 =
    Thread.create (fun () ->
      set_timeout ();
      print_string (Printf.sprintf "t1 id: %d\n" (mytid()));

      let xs = [1;2;3] in
      while(true) do
        let _ = List.map (fun x -> x + 1) xs in
        ()
      done;
      ()
    ) ()
  in

  let t2 =
    Thread.create (fun () ->
      set_timeout ();
      print_string (Printf.sprintf "t2 id: %d\n" (mytid()));

      let xs = [1;2;3] in
      while(true) do
        let _ = List.map (fun x -> x + 1) xs in
        ()
      done;
      ()
    ) ()
  in
  Thread.join t1;
  Thread.join t2;
  ()

------------------




Here is the output
Time is up!
t2 id: 2
t1 id: 1
id: 1
Thread 1 killed on uncaught exception Signals_and_threads.Timeout
.... <the program loops, meaning the second thread never received its timeout