diff --git a/lib/picos_structured/picos_structured.mli b/lib/picos_structured/picos_structured.mli index aaec6344..2348ae78 100644 --- a/lib/picos_structured/picos_structured.mli +++ b/lib/picos_structured/picos_structured.mli @@ -185,11 +185,24 @@ module Promise : sig (** [try_terminate promise] tries to terminate the promise by canceling it with the {{!Control.Terminate} [Terminate]} exception and returns [true] in case of success and [false] in case the promise had already completed, - i.e. either returned, raised, or canceled. *) + i.e. either returned, raised, or canceled. + + The optional [callstack] argument specifies the number of callstack + entries to capture with the {{!Control.Terminate} [Terminate]} exception. + The default is [0]. *) val terminate : ?callstack:int -> 'a t -> unit (** [terminate promise] is equivalent to {{!try_terminate} [try_terminate promise |> ignore]}. *) + + val terminate_after : ?callstack:int -> 'a t -> seconds:float -> unit + (** [terminate_after ~seconds promise] arranges to terminate the [promise] by + canceling it with the {{!Control.Terminate} [Terminate]} exception after + the specified number of [seconds]. + + The optional [callstack] argument specifies the number of callstack + entries to capture with the {{!Control.Terminate} [Terminate]} exception. + The default is [0]. *) end module Bundle : sig diff --git a/lib/picos_structured/promise.ml b/lib/picos_structured/promise.ml index 183047f7..f9317a24 100644 --- a/lib/picos_structured/promise.ml +++ b/lib/picos_structured/promise.ml @@ -13,3 +13,7 @@ let try_terminate ?callstack t = Computation.try_cancel t terminate_bt let terminate ?callstack t = try_terminate ?callstack t |> ignore + +let terminate_after ?callstack t ~seconds = + let terminate_bt = Control.terminate_bt ?callstack () in + Computation.cancel_after t ~seconds terminate_bt diff --git a/test/dune b/test/dune index f1cad25d..a51bfdb6 100644 --- a/test/dune +++ b/test/dune @@ -47,7 +47,7 @@ (modules test_lwt_unix) (build_if (>= %{ocaml_version} 5.0.0)) - (libraries picos.lwt_unix alcotest)) + (libraries picos.lwt_unix picos.structured alcotest)) ;; diff --git a/test/test_lwt_unix.ml b/test/test_lwt_unix.ml index c24eec67..2111bbfb 100644 --- a/test/test_lwt_unix.ml +++ b/test/test_lwt_unix.ml @@ -1,21 +1,16 @@ -open Picos +open Picos_structured let basics () = Lwt_main.run @@ Picos_lwt_unix.run @@ fun () -> - let computation = Computation.create () in + Bundle.join_after @@ fun bundle -> let child = - Computation.capture computation @@ fun () -> + Bundle.fork_as_promise bundle @@ fun () -> while true do Picos_lwt.await (Lwt_unix.sleep 0.01) done in - Fiber.spawn ~forbid:false computation [ child ]; - Computation.cancel_after computation ~seconds:0.05 - (Exn_bt.get_callstack 0 Exit); - match Computation.await computation with - | () -> assert false - | exception Exit -> () + Promise.terminate_after ~seconds:0.05 child let () = [ ("Basics", [ Alcotest.test_case "" `Quick basics ]) ]