diff --git a/src/lang/lang_builtins.ml b/src/lang/lang_builtins.ml index 6380d3a42b..efdaa88752 100644 --- a/src/lang/lang_builtins.ml +++ b/src/lang/lang_builtins.ml @@ -1747,7 +1747,7 @@ let () = in (timed_out, !status)) in - on_done (if 0. <= timeout then asynchronous() else synchronous ())) + on_done (if 0. <= timeout && Tutils.has_started() then asynchronous() else synchronous ())) let () = let ret_t = Lang.list_t (Lang.product_t Lang.string_t Lang.string_t) in diff --git a/src/tools/tutils.ml b/src/tools/tutils.ml index 8d4639363c..fd94ea99d9 100644 --- a/src/tools/tutils.ml +++ b/src/tools/tutils.ml @@ -182,6 +182,13 @@ type priority = let scheduler = Duppy.create () +let started = ref false + +let started_m = Mutex.create () + +let has_started = mutexify started_m (fun () -> + !started) + let () = let name = "Duppy scheduler shutdown" in let f () = @@ -239,7 +246,9 @@ let () = new_queue ~priorities:(fun x -> x = Non_blocking) ~name () - done)) + done; + mutexify started_m (fun () -> + started := true) ())) (** Replace stdout/err by a pipe, and install a Duppy task that pulls data * out of that pipe and logs it. diff --git a/src/tools/tutils.mli b/src/tools/tutils.mli index 97c66c0adf..ec6a87091c 100644 --- a/src/tools/tutils.mli +++ b/src/tools/tutils.mli @@ -31,6 +31,7 @@ raises an exception. *) val create : ('a -> unit) -> 'a -> string -> Thread.t val main : unit -> unit +val has_started : unit -> bool val shutdown : unit -> unit (** Special exception allowed for "clean" termination of Tutils threads.