aboutsummaryrefslogtreecommitdiffhomepage
path: root/lib
diff options
context:
space:
mode:
authorGravatar Emilio Jesus Gallego Arias <e+git@x80.org>2018-05-07 16:09:24 +0200
committerGravatar Emilio Jesus Gallego Arias <e+git@x80.org>2018-05-07 17:34:18 +0200
commitca65a79c1d2aa0e64e8974ea167029e6c48c4924 (patch)
tree995c8365969710725b3f24247ef9388b511edf72 /lib
parent6c8b00e47334f60f200256d45a5542fa80ce4b12 (diff)
[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.
Diffstat (limited to 'lib')
-rw-r--r--lib/control.ml5
-rw-r--r--lib/control.mli5
2 files changed, 9 insertions, 1 deletions
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