aboutsummaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/cUnix.ml5
-rw-r--r--lib/cUnix.mli7
-rw-r--r--lib/control.ml18
-rw-r--r--lib/control.mli11
4 files changed, 21 insertions, 20 deletions
diff --git a/lib/cUnix.ml b/lib/cUnix.ml
index 867f86a746..34fb660db4 100644
--- a/lib/cUnix.ml
+++ b/lib/cUnix.ml
@@ -14,6 +14,11 @@ type load_path = physical_path list
let physical_path_of_string s = s
let string_of_physical_path p = p
+let escaped_string_of_physical_path p =
+ (* We assume a reasonable-enough path (typically utf8) and prevents
+ the presence of space; other escapings might be useful... *)
+ if String.contains p ' ' then "\"" ^ p ^ "\"" else p
+
let path_to_list p =
let sep = Str.regexp (if Sys.os_type = "Win32" then ";" else ":") in
Str.split sep p
diff --git a/lib/cUnix.mli b/lib/cUnix.mli
index a394814041..d08dc4c403 100644
--- a/lib/cUnix.mli
+++ b/lib/cUnix.mli
@@ -14,9 +14,12 @@ type load_path = physical_path list
val physical_path_of_string : string -> physical_path
val string_of_physical_path : physical_path -> string
+(** Escape what has to be escaped (e.g. surround with quotes if with spaces) *)
+val escaped_string_of_physical_path : physical_path -> string
+
val canonical_path_name : string -> string
-(** remove all initial "./" in a path *)
+(** Remove all initial "./" in a path *)
val remove_path_dot : string -> string
(** If a path [p] starts with the current directory $PWD then
@@ -61,6 +64,6 @@ val sys_command : string -> string list -> Unix.process_status
val waitpid_non_intr : int -> Unix.process_status
-(** checks if two file names refer to the same (existing) file *)
+(** Check if two file names refer to the same (existing) file *)
val same_file : string -> string -> bool
diff --git a/lib/control.ml b/lib/control.ml
index f5d7df204e..d936d7557b 100644
--- a/lib/control.ml
+++ b/lib/control.ml
@@ -26,7 +26,7 @@ let check_for_interrupt () =
end
(** This function does not work on windows, sigh... *)
-let unix_timeout n f e =
+let unix_timeout n f x e =
let timeout_handler _ = raise e in
let psh = Sys.signal Sys.sigalrm (Sys.Signal_handle timeout_handler) in
let _ = Unix.alarm n in
@@ -35,7 +35,7 @@ let unix_timeout n f e =
Sys.set_signal Sys.sigalrm psh
in
try
- let res = f () in
+ let res = f x in
restore_timeout ();
res
with e ->
@@ -43,7 +43,7 @@ let unix_timeout n f e =
restore_timeout ();
Exninfo.iraise e
-let windows_timeout n f e =
+let windows_timeout n f x e =
let killed = ref false in
let exited = ref false in
let thread init =
@@ -60,7 +60,7 @@ let windows_timeout n f e =
let init = Unix.gettimeofday () in
let _id = Thread.create thread init in
try
- let res = f () in
+ let res = f x in
let () = killed := true in
let cur = Unix.gettimeofday () in
(** The thread did not interrupt, but the computation took longer than
@@ -80,12 +80,10 @@ let windows_timeout n f e =
let e = Backtrace.add_backtrace e in
Exninfo.iraise e
-type timeout = { timeout : 'a. int -> (unit -> 'a) -> exn -> 'a }
+type timeout = { timeout : 'a 'b. int -> ('a -> 'b) -> 'a -> exn -> 'b }
let timeout_fun = match Sys.os_type with
-| "Unix" | "Cygwin" -> ref { timeout = unix_timeout }
-| _ -> ref { timeout = windows_timeout }
+| "Unix" | "Cygwin" -> { timeout = unix_timeout }
+| _ -> { timeout = windows_timeout }
-let set_timeout f = timeout_fun := f
-
-let timeout n f e = !timeout_fun.timeout n f e
+let timeout n f e = timeout_fun.timeout n f e
diff --git a/lib/control.mli b/lib/control.mli
index 337cdf67b0..f6c63ffb34 100644
--- a/lib/control.mli
+++ b/lib/control.mli
@@ -16,11 +16,6 @@ val check_for_interrupt : unit -> unit
(** Use this function as a potential yield function. If {!interrupt} has been
set, il will raise [Sys.Break]. *)
-val timeout : int -> (unit -> 'a) -> exn -> 'a
-(** [timeout n f e] tries to compute [f], and if it fails to do so before [n]
- seconds, it raises [e] instead. *)
-
-type timeout = { timeout : 'a. int -> (unit -> 'a) -> exn -> 'a }
-
-val set_timeout : timeout -> unit
-(** Set a particular timeout function. *)
+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. *)