From ca65a79c1d2aa0e64e8974ea167029e6c48c4924 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Mon, 7 May 2018 16:09:24 +0200 Subject: [lib] Re-add `set_timeout` to help users workaround #7408 It seems like #7408 will need some potentially intrusive work, so let's add the low-level hook back so third party developments can work well with `8.8.1/master` for the moment. --- lib/control.ml | 5 ++++- lib/control.mli | 5 +++++ 2 files changed, 9 insertions(+), 1 deletion(-) (limited to 'lib') diff --git a/lib/control.ml b/lib/control.ml index e67cd8b38..3fbeb168c 100644 --- a/lib/control.ml +++ b/lib/control.ml @@ -85,4 +85,7 @@ let timeout_fun = match Sys.os_type with | "Unix" | "Cygwin" -> { timeout = unix_timeout } | _ -> { timeout = windows_timeout } -let timeout n f e = timeout_fun.timeout n f e +let timeout_fun_ref = ref timeout_fun +let set_timeout f = timeout_fun_ref := f + +let timeout n f e = !timeout_fun_ref.timeout n f e diff --git a/lib/control.mli b/lib/control.mli index 415e05462..59e2a1515 100644 --- a/lib/control.mli +++ b/lib/control.mli @@ -24,3 +24,8 @@ val check_for_interrupt : unit -> unit val timeout : int -> ('a -> 'b) -> 'a -> exn -> 'b (** [timeout n f x e] tries to compute [f x], and if it fails to do so before [n] seconds, it raises [e] instead. *) + +(** Set a particular timeout function; warning, this is an internal + API and it is scheduled to go away. *) +type timeout = { timeout : 'a 'b. int -> ('a -> 'b) -> 'a -> exn -> 'b } +val set_timeout : timeout -> unit -- cgit v1.2.3