diff --git a/behavior.ml b/behavior.ml index 142f3d4c..97d82c5b 100644 --- a/behavior.ml +++ b/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 diff --git a/behavior.mli b/behavior.mli index db119e7f..64ea4159 100644 --- a/behavior.mli +++ b/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 *) diff --git a/tests/run_tests.ml b/tests/run_tests.ml index c1103122..06c04f6d 100644 --- a/tests/run_tests.ml +++ b/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; diff --git a/tests/test_Behavior.ml b/tests/test_Behavior.ml new file mode 100644 index 00000000..e6d595ce --- /dev/null +++ b/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; + ]