Add some unit tests for fibers. (#1156)
Signed-off-by: Pavel Senchanka <pavel.senchanka@gmail.com>
This commit is contained in:
parent
64755f8826
commit
b7da0304f1
|
@ -38,6 +38,17 @@
|
|||
(run %{exe:expect_test.exe} %{t})
|
||||
(diff? %{t} %{t}.corrected)))))
|
||||
|
||||
(alias
|
||||
(name runtest)
|
||||
(deps (:t fiber.mlt)
|
||||
(glob_files %{project_root}/src/.dune.objs/*.cmi)
|
||||
(glob_files %{project_root}/src/stdune/.stdune.objs/*.cmi)
|
||||
(glob_files %{project_root}/src/fiber/.fiber.objs/*.cmi))
|
||||
(action (chdir %{project_root}
|
||||
(progn
|
||||
(run %{exe:expect_test.exe} %{t})
|
||||
(diff? %{t} %{t}.corrected)))))
|
||||
|
||||
(alias
|
||||
(name runtest)
|
||||
(deps (:t import_dot_map.mlt)
|
||||
|
|
|
@ -80,6 +80,7 @@ let main () =
|
|||
List.iter
|
||||
[ "src/dsexp/.dsexp.objs"
|
||||
; "src/stdune/.stdune.objs"
|
||||
; "src/fiber/.fiber.objs"
|
||||
; "src/.dune.objs"
|
||||
]
|
||||
~f:Topdirs.dir_directory;
|
||||
|
|
|
@ -0,0 +1,149 @@
|
|||
open Dune;;
|
||||
open Stdune;;
|
||||
open Fiber;;
|
||||
open Fiber.O;;
|
||||
|
||||
let failing_fiber () : unit Fiber.t =
|
||||
Fiber.yield ()
|
||||
>>= fun () ->
|
||||
raise Exit
|
||||
;;
|
||||
|
||||
let long_running_fiber () =
|
||||
let rec loop n =
|
||||
if n = 0 then
|
||||
Fiber.return ()
|
||||
else
|
||||
Fiber.yield ()
|
||||
>>= fun () ->
|
||||
loop (n - 1)
|
||||
in
|
||||
loop 10
|
||||
;;
|
||||
|
||||
let never_fiber () =
|
||||
Fiber.never
|
||||
;;
|
||||
|
||||
[%%expect{|
|
||||
val failing_fiber : unit -> unit t = <fun>
|
||||
val long_running_fiber : unit -> unit t = <fun>
|
||||
val never_fiber : unit -> 'a t = <fun>
|
||||
|}]
|
||||
|
||||
Fiber.run (Fiber.collect_errors failing_fiber)
|
||||
[%%expect{|
|
||||
- : (unit, exn list) Stdune.result = Error [Exit]
|
||||
|}]
|
||||
|
||||
try
|
||||
ignore (Fiber.run (Fiber.collect_errors never_fiber) : (unit, exn list) Result.t);
|
||||
Result.Error "should not reach here"
|
||||
with Fiber.Never ->
|
||||
Result.ok ()
|
||||
;;
|
||||
[%%expect{|
|
||||
- : (unit, string) Stdune.result = Ok ()
|
||||
|}]
|
||||
|
||||
Fiber.run (
|
||||
Fiber.collect_errors (fun () -> (
|
||||
failing_fiber ()
|
||||
>>= fun () ->
|
||||
failing_fiber ())))
|
||||
;;
|
||||
[%%expect{|
|
||||
- : (unit, exn list) Stdune.result = Error [Exit]
|
||||
|}]
|
||||
|
||||
Fiber.run (
|
||||
Fiber.collect_errors (fun () -> Fiber.with_error_handler failing_fiber ~on_error:ignore))
|
||||
[%%expect{|
|
||||
- : (unit, exn list) Stdune.result = Error []
|
||||
|}]
|
||||
|
||||
Fiber.run (
|
||||
Fiber.collect_errors (fun () -> Fiber.with_error_handler failing_fiber ~on_error:ignore)
|
||||
>>| fun result -> "")
|
||||
[%%expect{|
|
||||
- : string = ""
|
||||
|}]
|
||||
|
||||
Fiber.run (
|
||||
Fiber.collect_errors
|
||||
(fun () -> Fiber.fork_and_join failing_fiber long_running_fiber))
|
||||
[%%expect{|
|
||||
- : (unit * unit, exn list) Stdune.result = Error [Exit]
|
||||
|}]
|
||||
|
||||
Fiber.run (
|
||||
Fiber.fork_and_join
|
||||
(fun () ->
|
||||
Fiber.collect_errors failing_fiber
|
||||
>>| fun _ -> "")
|
||||
long_running_fiber)
|
||||
[%%expect{|
|
||||
- : string * unit = ("", ())
|
||||
|}]
|
||||
|
||||
let flag_set = ref false;;
|
||||
let never_raised = ref false;;
|
||||
|
||||
try
|
||||
Fiber.run (
|
||||
Fiber.fork_and_join_unit
|
||||
never_fiber
|
||||
(fun () ->
|
||||
Fiber.collect_errors failing_fiber
|
||||
>>= fun _ ->
|
||||
long_running_fiber ()
|
||||
>>= fun _ -> Fiber.return (flag_set := true)))
|
||||
with Fiber.Never ->
|
||||
never_raised := true
|
||||
;;
|
||||
[%%expect{|
|
||||
val flag_set : bool ref = {contents = false}
|
||||
val never_raised : bool ref = {contents = false}
|
||||
- : unit = ()
|
||||
|}]
|
||||
|
||||
!flag_set && !never_raised;;
|
||||
[%%expect{|
|
||||
- : bool = true
|
||||
|}]
|
||||
|
||||
let flag_set = ref false;;
|
||||
let never_raised = ref false;;
|
||||
|
||||
let forking_fiber () =
|
||||
Fiber.parallel_map [1;2;3;4;5]
|
||||
~f:(fun x ->
|
||||
Fiber.yield ()
|
||||
>>= fun () ->
|
||||
if x mod 2 = 1 then
|
||||
Process.run Process.Strict ~env:Env.initial (Option.value_exn (Bin.which "true")) []
|
||||
else
|
||||
Process.run Process.Strict ~env:Env.initial (Option.value_exn (Bin.which "false")) [])
|
||||
in
|
||||
try
|
||||
Fiber.run (
|
||||
Fiber.fork_and_join_unit
|
||||
never_fiber
|
||||
(fun () ->
|
||||
Fiber.collect_errors forking_fiber
|
||||
>>= fun _ ->
|
||||
long_running_fiber ()
|
||||
>>= fun _ -> Fiber.return (flag_set := true)))
|
||||
with Fiber.Never ->
|
||||
never_raised := true
|
||||
;;
|
||||
[%%expect{|
|
||||
val flag_set : bool ref = {contents = false}
|
||||
val never_raised : bool ref = {contents = false}
|
||||
- : unit = ()
|
||||
|}]
|
||||
|
||||
!flag_set && !never_raised;;
|
||||
[%%expect{|
|
||||
- : bool = true
|
||||
|}]
|
Loading…
Reference in New Issue