111 lines
3.5 KiB
OCaml
111 lines
3.5 KiB
OCaml
|
open Stdune
|
||
|
|
open! Dune_tests_common
|
||
|
|
open Dune_engine
|
||
|
|
open Fiber.O
|
||
|
|
|
||
|
|
let () = init ()
|
||
|
|
|
||
|
|
let default =
|
||
|
|
Clflags.display := Short;
|
||
|
|
{ Scheduler.Config.concurrency = 1
|
||
|
|
; stats = None
|
||
|
|
; print_ctrl_c_warning = false
|
||
|
|
; watch_exclusions = []
|
||
|
|
}
|
||
|
|
;;
|
||
|
|
|
||
|
|
let go ?(timeout_seconds = 0.3) ?(config = default) f =
|
||
|
|
try
|
||
|
|
Scheduler.Run.go
|
||
|
|
~timeout_seconds
|
||
|
|
config
|
||
|
|
~file_watcher:No_watcher
|
||
|
|
~on_event:(fun _ _ -> ())
|
||
|
|
f
|
||
|
|
with
|
||
|
|
| Scheduler.Run.Shutdown.E Requested -> ()
|
||
|
|
;;
|
||
|
|
|
||
|
|
let true_ = Bin.which "true" ~path:(Env_path.path Env.initial) |> Option.value_exn
|
||
|
|
let cell = Memo.lazy_cell Memo.return
|
||
|
|
|
||
|
|
let%expect_test "cancelling a build" =
|
||
|
|
let build_started = Fiber.Ivar.create () in
|
||
|
|
let build_cancelled = Fiber.Ivar.create () in
|
||
|
|
go (fun () ->
|
||
|
|
Fiber.fork_and_join_unit
|
||
|
|
(fun () ->
|
||
|
|
Scheduler.Run.poll
|
||
|
|
(let* () = Fiber.Ivar.fill build_started () in
|
||
|
|
let* () = Fiber.Ivar.read build_cancelled in
|
||
|
|
let* res =
|
||
|
|
Fiber.collect_errors (fun () ->
|
||
|
|
Scheduler.with_job_slot (fun _ _ -> Fiber.return ()))
|
||
|
|
in
|
||
|
|
print_endline
|
||
|
|
(match res with
|
||
|
|
| Ok () -> "FAIL: build wasn't cancelled"
|
||
|
|
| Error _ -> "PASS: build was cancelled");
|
||
|
|
let* () = Scheduler.shutdown () in
|
||
|
|
Fiber.never))
|
||
|
|
(fun () ->
|
||
|
|
let* () = Fiber.Ivar.read build_started in
|
||
|
|
let* () =
|
||
|
|
Scheduler.inject_memo_invalidation (Memo.Cell.invalidate cell ~reason:Unknown)
|
||
|
|
in
|
||
|
|
(* Wait for the scheduler to acknowledge the change *)
|
||
|
|
let* () = Scheduler.wait_for_build_input_change () in
|
||
|
|
Fiber.Ivar.fill build_cancelled ()));
|
||
|
|
[%expect {| PASS: build was cancelled |}]
|
||
|
|
;;
|
||
|
|
|
||
|
|
(* CR-soon jeremiedimino: currently cancelling a build cancels not only this
|
||
|
|
build but also all running fibers, including ones that are unrelated. *)
|
||
|
|
let%expect_test "cancelling a build: effect on other fibers" =
|
||
|
|
let build_started = Fiber.Ivar.create () in
|
||
|
|
go (fun () ->
|
||
|
|
Fiber.fork_and_join_unit
|
||
|
|
(fun () ->
|
||
|
|
Scheduler.Run.poll
|
||
|
|
(let* () = Fiber.Ivar.fill build_started () in
|
||
|
|
Fiber.never))
|
||
|
|
(fun () ->
|
||
|
|
let* () = Fiber.Ivar.read build_started in
|
||
|
|
let* () =
|
||
|
|
Scheduler.inject_memo_invalidation (Memo.Cell.invalidate cell ~reason:Unknown)
|
||
|
|
in
|
||
|
|
let* () = Scheduler.wait_for_build_input_change () in
|
||
|
|
let* res = Fiber.collect_errors (fun () -> Fiber.return ()) in
|
||
|
|
print_endline
|
||
|
|
(match res with
|
||
|
|
| Ok () -> "PASS: we can still run things outside the build"
|
||
|
|
| Error _ -> "FAIL: other fiber got cancelled");
|
||
|
|
Scheduler.shutdown ()));
|
||
|
|
[%expect {| PASS: we can still run things outside the build |}]
|
||
|
|
;;
|
||
|
|
|
||
|
|
let%expect_test "raise inside Scheduler.Run.go" =
|
||
|
|
(try
|
||
|
|
(go
|
||
|
|
@@ fun () ->
|
||
|
|
Fiber.fork_and_join_unit
|
||
|
|
(fun () ->
|
||
|
|
print_endline "t1";
|
||
|
|
Fiber.return ())
|
||
|
|
(fun () -> raise Exit));
|
||
|
|
assert false
|
||
|
|
with
|
||
|
|
| Dune_util.Report_error.Already_reported -> print_endline "--> exception observed");
|
||
|
|
[%expect
|
||
|
|
{|
|
||
|
|
t1
|
||
|
|
Error: exception Stdlib.Exit
|
||
|
|
|
||
|
|
I must not crash. Uncertainty is the mind-killer. Exceptions are the
|
||
|
|
little-death that brings total obliteration. I will fully express my cases.
|
||
|
|
Execution will pass over me and through me. And when it has gone past, I
|
||
|
|
will unwind the stack along its path. Where the cases are handled there will
|
||
|
|
be nothing. Only I will remain.
|
||
|
|
--> exception observed |}]
|
||
|
|
;;
|