Skip to content

Instantly share code, notes, and snippets.

@Octachron
Created November 24, 2022 09:40
Show Gist options
  • Save Octachron/d485c03962a3948dc5262620a25e75a0 to your computer and use it in GitHub Desktop.
Save Octachron/d485c03962a3948dc5262620a25e75a0 to your computer and use it in GitHub Desktop.
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 "?@."
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment