some tests for Behavior; also a new constructor

behavior.ml

@@ -29,7 +29,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 type tree =
   | Test of bool React.event                (* test the next occurrence *)
-  | TestS of bool React.signal              (* test the current value *)
+  | TestFun of (unit -> bool)               (* call and test value *)
   | Wait of unit React.event                (* wait for the event to trigger *)
   | Timeout of float                        (* fails after the given timeout *)
   | Do of (unit -> bool)                    (* perform an action *)
@@ -71,7 +71,9 @@ let mk_fail = Fail
 
 let mk_test e = Test e
 
-let mk_test_s s = TestS s
+let mk_test_s s = TestFun (fun () -> React.S.value s)
+
+let mk_test_fun f = TestFun f
 
 let mk_wait e = Wait e
 
@@ -238,7 +240,7 @@ let run ?delay tree =
   let rec run tree = 
     match tree with
     | Test e -> Fut.next e
-    | TestS s -> Fut.return (S.value s)
+    | TestFun f -> Fut.return (f ())
     | Wait e -> Fut.next (E.stamp e true)
     | Timeout howlong ->
       begin match delay with

behavior.mli

@@ -50,7 +50,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 type tree = private
   | Test of bool React.event                (* test the next occurrence *)
-  | TestS of bool React.signal              (* test the current value *)
+  | TestFun of (unit -> bool)               (* call and test value *)
   | Wait of unit React.event                (* wait for the event to trigger *)
   | Timeout of float                        (* fails after the given timeout *)
   | Do of (unit -> bool)                    (* perform an action *)
@@ -88,6 +88,9 @@ val mk_test : bool React.event -> tree
 val mk_test_s : bool React.signal -> tree
   (** Fails or succeeds based on the current signal value *)
 
+val mk_test_fun : (unit -> bool) -> tree
+  (** Tests that the result of calling this function is true *)
+
 val mk_wait : unit React.event -> tree
   (** Wait for the event to trigger, then succeed *)
 

tests/run_tests.ml

@@ -6,6 +6,7 @@ let suite =
   "all_tests" >:::
     [ Test_pHashtbl.suite;
       Test_PersistentHashtbl.suite;
+      Test_Behavior.suite;
       Test_PiCalculus.suite;
       Test_splayMap.suite;
       Test_bij.suite;

tests/test_Behavior.ml

@@ -0,0 +1,69 @@
+
+open OUnit
+
+module B = Behavior
+
+let test_do () =
+  let r = ref false in
+  let t = B.mk_do_ok (fun () -> r := true) in
+  let res = B.run t in
+  OUnit.assert_equal true !r;
+  OUnit.assert_equal (Some true) (React.S.value (B.Fut.wait res));
+  ()
+
+let test_seq () =
+  let l = ref [] in
+  (* add int to [l] *)
+  let add x = l := x :: !l in
+  let t = B.mk_sequence
+    [ B.mk_do (fun () -> add 3; true);
+      B.mk_do (fun () -> add 2; true);
+      B.mk_test_fun (fun () -> List.length !l = 2);
+      B.mk_do (fun () -> add 1; true);
+    ] in
+  let res = B.run t in
+  OUnit.assert_equal [1;2;3] !l;
+  OUnit.assert_equal (Some true) (React.S.value (B.Fut.wait res));
+  ()
+
+let test_wait () =
+  let e, send_e = React.E.create () in
+  let t = B.mk_sequence [B.mk_wait e; B.mk_succeed] in
+  let signal = B.Fut.wait (B.run t) in
+  OUnit.assert_equal None (React.S.value signal);
+  send_e ();
+  OUnit.assert_equal (Some true) (React.S.value signal);
+  ()
+
+let test_parallel () =
+  let e, send_e = React.E.create () in
+  (* forall fails *)
+  let t =
+    B.mk_parallel ~strat:B.PSForall
+      [ B.mk_sequence [B.mk_wait e; B.mk_succeed];
+        B.mk_fail
+      ] in
+  let signal = B.Fut.wait (B.run t) in
+  OUnit.assert_equal (Some false) (React.S.value signal);
+  send_e ();
+  OUnit.assert_equal (Some false) (React.S.value signal);
+  (* exists succeeds *)
+  let t =
+    B.mk_parallel ~strat:B.PSExists
+      [ B.mk_sequence [B.mk_wait e; B.mk_succeed];
+        B.mk_fail
+      ] in
+  let signal = B.Fut.wait (B.run t) in
+  OUnit.assert_equal None (React.S.value signal);
+  send_e ();
+  OUnit.assert_equal (Some true) (React.S.value signal);
+  ()
+
+
+let suite =
+  "test_behavior" >:::
+    [ "test_do" >:: test_do;
+      "test_seq" >:: test_seq;
+      "test_wait" >:: test_wait;
+      "test_parallel" >:: test_parallel;
+    ]