timeout_with_select.ml

let with_timeout timeout (f:unit -> 'b) =
  let read, write = Unix.pipe () in
  match Unix.fork () with
  | 0 ->
    let result = f () in
    let chan = Unix.out_channel_of_descr write in
    Marshal.to_channel  chan result [];
    Out_channel.flush chan;
    Unix.close write;
    exit 0
  | child ->
    match Unix.select [read] [] [] timeout with
      | [read], [], [] ->
        let r = Some (Marshal.from_channel (Unix.in_channel_of_descr read)) in
        Unix.close read;
        (r: 'b option)
      | [], [], [] | _ ->
        Unix.kill child Sys.sigkill;
        None

let rec loop () = loop ()
let one () = 1

let test = with_timeout 0.1 loop
let () = match with_timeout 0.1 one with
  | Some x -> Format.printf "one=%d@." x
  | None -> Format.printf "?@."