From b7da0304f1d58544c177f2f10ad073eaf70f6c22 Mon Sep 17 00:00:00 2001
From: Pavel Senchanka <pavel.senchanka@gmail.com>
Date: Thu, 23 Aug 2018 17:56:17 +0100
Subject: [PATCH] Add some unit tests for fibers. (#1156)

Signed-off-by: Pavel Senchanka <pavel.senchanka@gmail.com>
---
 test/unit-tests/dune            |  11 +++
 test/unit-tests/expect_test.mll |   1 +
 test/unit-tests/fiber.mlt       | 149 ++++++++++++++++++++++++++++++++
 3 files changed, 161 insertions(+)
 create mode 100644 test/unit-tests/fiber.mlt

diff --git a/test/unit-tests/dune b/test/unit-tests/dune
index 8e3ac417..e0abe874 100644
--- a/test/unit-tests/dune
+++ b/test/unit-tests/dune
@@ -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)
diff --git a/test/unit-tests/expect_test.mll b/test/unit-tests/expect_test.mll
index ddc29312..d0b81cf0 100644
--- a/test/unit-tests/expect_test.mll
+++ b/test/unit-tests/expect_test.mll
@@ -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;
diff --git a/test/unit-tests/fiber.mlt b/test/unit-tests/fiber.mlt
new file mode 100644
index 00000000..3b9fb645
--- /dev/null
+++ b/test/unit-tests/fiber.mlt
@@ -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
+|}]