Test.check_exn and more unit tests

src/core/QCheck2.mli

@@ -1647,8 +1647,8 @@ module Test : sig
   val check_result : 'a cell -> 'a TestResult.t -> unit
   (** [check_result cell res] checks that [res] is [Ok _], and returns unit.
       Otherwise, it raises some exception.
-      @raise Test_error if [res = Error _]
-      @raise Test_error if [res = Failed _] *)
+      @raise Test_fail  if [res = Failed _]
+      @raise Test_error if [res = Error _] *)
 
   type res =
     | Success
@@ -1695,14 +1695,14 @@ module Test : sig
     ?long:bool -> ?call:'a callback -> ?step:'a step ->
     ?rand:Random.State.t -> 'a cell -> unit
   (** Same as {!check_cell} but calls  {!check_result} on the result.
-      @raise Test_error if [res = Error _]
-      @raise Test_error if [res = Failed _] *)
+      @raise Test_fail  if [res = Failed _]
+      @raise Test_error if [res = Error _] *)
 
   val check_exn : ?long:bool -> ?rand:Random.State.t -> t -> unit
   (** Checks the property against some test cases, and calls {!check_result},
       which might raise an exception in case of failure.
-      @raise Test_error if [res = Error _]
-      @raise Test_error if [res = Failed _] *)
+      @raise Test_fail  if [res = Failed _]
+      @raise Test_error if [res = Error _] *)
 end
 
 (** {2 Sub-tests} *)

test/core/qcheck2_output.txt.expected → test/core/QCheck2_expect_test.expected

@@ -1,168 +1,4 @@
 random seed: 1234
-2724675603984413065
-0
-1362337801992206532
-0
-681168900996103266
-0
-340584450498051633
-0
-170292225249025816
-0
-85146112624512908
-0
-42573056312256454
-0
-21286528156128227
-0
-10643264078064113
-0
-5321632039032056
-0
-2660816019516028
-0
-1330408009758014
-0
-665204004879007
-0
-332602002439503
-0
-166301001219751
-0
-83150500609875
-0
-41575250304937
-0
-20787625152468
-0
-10393812576234
-0
-5196906288117
-0
-2598453144058
-0
-1299226572029
-0
-649613286014
-0
-324806643007
-0
-162403321503
-0
-81201660751
-0
-40600830375
-0
-20300415187
-0
-10150207593
-0
-5075103796
-0
-2537551898
-0
-1268775949
-0
-634387974
-0
-317193987
-0
-158596993
-0
-79298496
-0
-39649248
-0
-19824624
-0
-9912312
-0
-4956156
-0
-2478078
-0
-1239039
-0
-619519
-0
-309759
-0
-154879
-0
-77439
-0
-38719
-0
-19359
-0
-9679
-0
-4839
-0
-2419
-0
-1209
-0
-604
-0
-302
-0
-151
-0
-75
-0
-37
-0
-18
-0
-9
-0
-4
-0
-2
-0
-1
-0
-[7; 1; 42; 1; 8; 5; 3; 9; 5; 38; 3; 3; 0; 1; 98; 1; 4; 13; 9; 2; 6; 9; 47; 6; 5; 8; 8; 6; 0; 9; 7; 2; 8; 6; 62; 6; 4; 31; 19; 1; 41; 60; 6; 5; 8; 1; 1; 4; 7; 7; 0; 5; 5; 71; 14; 26; 47; 5; 1; 6; 34; 9; 4; 2; 37; 3; 8; 4; 31; 6; 2; 1; 0; 7; 5; 1; 0; 15; 6; 1; 8; 13; 0; 6; 2; 4; 2; 6; 6; 1; 4; 1; 9; 79; 0; 87; 6; 8; 8; 62; 1; 4; 62; 6; 31; 1; 5; 6; 5; 9; 3; 3; 1; 79; 4; 3; 2; 67; 5; 7; 12; 70; 8; 8; 6; 1; 3; 14; 15; 1; 61; 4; 1; 4; 1; 7; 4; 4; 4; 2; 8; 8; 7; 5; 4; 27; 0; 9; 80; 25; 1; 8; 1; 3; 7; 4; 3; 5; 5; 6; 5; 5; 31; 7; 0; 3; 3; 6; 71; 76; 28; 60; 6; 2; 6; 3; 0; 4; 1; 0; 5; 7; 0; 28; 86; 4; 7; 51; 36; 0; 5; 0; 1; 4; 3; 6; 0; 1; 1; 8; 18; 4; 2; 8; 8; 1; 4; 7; 1; 0; 93; 5; 3; 0; 80; 1; 7; 7; 8; 8; 5; 7; 8; 9; 24; 4; 25; 8; 8; 5; 4; 90; 4; 6; 8; 4; 4; 0; 60; 8; 9; 7; 44; 5; 1; 2; 9; 74; 7; 7]
-[]
-[9; 61; 8; 4; 69; 2; 0; 72; 4; 41; 3; 8; 75; 83; 7; 7; 3; 9; 5; 8; 4; 1; 0; 2; 1; 4; 7; 6; 2; 1; 4; 86; 3; 79; 7; 86; 52; 39; 19; 0; 4; 7; 7; 7; 0; 4; 8; 8; 0; 5; 13; 1; 5; 0; 7; 12; 64; 34; 1; 1; 85; 8; 2; 9; 76; 0; 2; 5; 76; 69; 8; 8; 0; 1; 2; 2; 4; 60; 29; 5; 9; 4; 0; 8; 3; 3; 5; 1; 35; 8; 2; 7; 23; 61; 56; 8; 1; 1; 78; 7; 5; 0; 30; 9; 3; 7; 28; 57; 98; 3; 52; 3; 82; 7; 5; 5; 6; 8; 1; 6; 8; 9; 8; 16; 0]
-[]
-[1; 9; 8; 28; 47; 8; 5; 6; 8; 9; 2; 5; 8; 30; 6; 8; 84; 0; 6; 7; 76; 7; 9; 1; 0; 5; 76; 95; 2; 2; 1; 45; 7; 8; 8; 1; 6; 37; 5; 6; 73; 8; 0; 85; 8; 0; 4; 5; 2; 0; 26; 59; 0; 5; 13; 4; 7; 3; 6; 8; 1; 3]
-[]
-[5; 0; 0; 4; 10; 2; 4; 9; 5; 73; 6; 1; 5; 5; 3; 10; 5; 31; 1; 4; 3; 8; 9; 13; 41; 20; 96; 5; 1; 2; 8]
-[]
-[9; 8; 73; 5; 8; 2; 1; 8; 2; 6; 4; 18; 5; 76; 3]
-[]
-[0; 6; 2; 8; 8; 1; 4]
-[]
-[5; 2; 3]
-[]
-[3]
-[]
-[0]
-[7; 1; 42; 1; 8; 5; 3; 9; 5; 38; 3; 3; 0; 1; 98; 1; 4; 13; 9; 2; 6; 9; 47; 6; 5; 8; 8; 6; 0; 9; 7; 2; 8; 6; 62; 6; 4; 31; 19; 1; 41; 60; 6; 5; 8; 1; 1; 4; 7; 7; 0; 5; 5; 71; 14; 26; 47; 5; 1; 6; 34; 9; 4; 2; 37; 3; 8; 4; 31; 6; 2; 1; 0; 7; 5; 1; 0; 15; 6; 1; 8; 13; 0; 6; 2; 4; 2; 6; 6; 1; 4; 1; 9; 79; 0; 87; 6; 8; 8; 62; 1; 4; 62; 6; 31; 1; 5; 6; 5; 9; 3; 3; 1; 79; 4; 3; 2; 67; 5; 7; 12; 70; 8; 8; 6; 1; 3; 14; 15; 1; 61; 4; 1; 4; 1; 7; 4; 4; 4; 2; 8; 8; 7; 5; 4; 27; 0; 9; 80; 25; 1; 8; 1; 3; 7; 4; 3; 5; 5; 6; 5; 5; 31; 7; 0; 3; 3; 6; 71; 76; 28; 60; 6; 2; 6; 3; 0; 4; 1; 0; 5; 7; 0; 28; 86; 4; 7; 51; 36; 0; 5; 0; 1; 4; 3; 6; 0; 1; 1; 8; 18; 4; 2; 8; 8; 1; 4; 7; 1; 0; 93; 5; 3; 0; 80; 1; 7; 7; 8; 8; 5; 7; 8; 9; 24; 4; 25; 8; 8; 5; 4; 90; 4; 6; 8; 4; 4; 0; 60; 8; 9; 7; 44; 5; 1; 2; 9; 74; 7; 7]
-[]
-[9; 61; 8; 4; 69; 2; 0; 72; 4; 41; 3; 8; 75; 83; 7; 7; 3; 9; 5; 8; 4; 1; 0; 2; 1; 4; 7; 6; 2; 1; 4; 86; 3; 79; 7; 86; 52; 39; 19; 0; 4; 7; 7; 7; 0; 4; 8; 8; 0; 5; 13; 1; 5; 0; 7; 12; 64; 34; 1; 1; 85; 8; 2; 9; 76; 0; 2; 5; 76; 69; 8; 8; 0; 1; 2; 2; 4; 60; 29; 5; 9; 4; 0; 8; 3; 3; 5; 1; 35; 8; 2; 7; 23; 61; 56; 8; 1; 1; 78; 7; 5; 0; 30; 9; 3; 7; 28; 57; 98; 3; 52; 3; 82; 7; 5; 5; 6; 8; 1; 6; 8; 9; 8; 16; 0]
-[]
-[1; 9; 8; 28; 47; 8; 5; 6; 8; 9; 2; 5; 8; 30; 6; 8; 84; 0; 6; 7; 76; 7; 9; 1; 0; 5; 76; 95; 2; 2; 1; 45; 7; 8; 8; 1; 6; 37; 5; 6; 73; 8; 0; 85; 8; 0; 4; 5; 2; 0; 26; 59; 0; 5; 13; 4; 7; 3; 6; 8; 1; 3]
-[]
-[5; 0; 0; 4; 10; 2; 4; 9; 5; 73; 6; 1; 5; 5; 3; 10; 5; 31; 1; 4; 3; 8; 9; 13; 41; 20; 96; 5; 1; 2; 8]
-[]
-[9; 8; 73; 5; 8; 2; 1; 8; 2; 6; 4; 18; 5; 76; 3]
-[]
-[0; 6; 2; 8; 8; 1; 4]
-[]
-[5; 2; 3]
-[3; 2; 7; 3; 3]
-[]
-[5; 3]
-[5; 3; 2]
-[9; 87; 7; 0]
-[0; 2; 7; 3; 3]
-[0; 0; 7; 3; 3]
-[0; 0; 0; 3; 3]
-[0; 0; 0; 0; 3]
-[0; 0; 0; 0; 0]
 
 --- Failure --------------------------------------------------------------------
 

test/core/QCheck2_expect_test.ml

@@ -165,7 +165,7 @@ module Shrink = struct
 
   let ints_are_0 =
     Test.make ~name:"ints are 0" ~count:1000 ~print:Print.int
-      Gen.int (fun i -> Printf.printf "%i\n" i; i = 0)
+      Gen.int (fun i -> i = 0)
 
   (* test from issue #59 *)
   let ints_smaller_209609 =
@@ -195,11 +195,9 @@ module Shrink = struct
       (fun s -> String.to_seq s |> Seq.fold_left (fun acc c -> acc && c <> '\255') true)
 
   (* tests from issue #64 *)
-  let print_list xs = print_endline Print.(list int xs)
-
   let lists_are_empty_issue_64 =
     Test.make ~name:"lists are empty" ~print:Print.(list int)
-      Gen.(list small_int) (fun xs -> print_list xs; xs = [])
+      Gen.(list small_int) (fun xs -> xs = [])
 
   let list_shorter_10 =
     Test.make ~name:"lists shorter than 10" ~print:Print.(list int)
@@ -230,7 +228,7 @@ module Shrink = struct
     Test.make ~name:"lists have unique elems" ~print:Print.(list int)
       Gen.(list small_int)
       (fun xs -> let ys = List.sort_uniq Int.compare xs in
-                 print_list xs; List.length xs = List.length ys)
+                 List.length xs = List.length ys)
 
   let tree_contains_only_42 =
     Test.make ~name:"tree contains only 42" ~print:IntTree.print_tree

test/core/test.ml → test/core/QCheck2_unit_tests.ml

@@ -91,7 +91,7 @@ module Gen = struct
        ])
 end
 
-module Test = struct
+module TestCount = struct
   let test_count_n ?count expected =
     let t = QCheck2.(Test.make ?count Gen.int (fun _ -> true)) in
     let msg = Printf.sprintf "QCheck2.Test.make ~count:%s |> get_count = %d"
@@ -112,7 +112,7 @@ module Test = struct
     Alcotest.(check int) "default count is from QCHECK_COUNT" 5 actual
 
   let tests =
-    ("Test", Alcotest.[
+    ("Test.make ~count", Alcotest.[
          test_case "make with custom count" `Quick test_count_10;
          test_case "make with custom count" `Quick test_count_0;
          test_case "make with default count" `Quick test_count_default;
@@ -129,11 +129,60 @@ module String = struct
   let tests = ("String", Alcotest.[test_case "shrinking" `Quick test_string_shrinking])
 end
 
+module Check_exn = struct
+
+  let check_exn = Test.check_exn
+
+  let test_pass_trivial () =
+    let run_test () = check_exn QCheck2.(Test.make Gen.int (fun _ -> true)) in
+    Alcotest.(check unit) "Success-trivial" () @@ run_test ()
+
+  let test_pass_random () =
+    let run_test () =
+      check_exn QCheck2.(Test.make Gen.(list int) (fun l -> List.rev (List.rev l) = l)) in
+    Alcotest.(check unit) "Success-random" () @@ run_test ()
+
+  let test_fail_always () =
+    let name = "will-always-fail" in
+    let counterex_str = "0 (after 2 shrink steps)" in
+    let run_test () =
+      check_exn QCheck2.(Test.make ~name ~print:Print.int Gen.int (fun _ -> false)) in
+    Alcotest.check_raises "Fail" (Test.Test_fail (name,[counterex_str])) run_test
+
+  let test_fail_random () =
+    let name = "list is own reverse" in
+    let counterex_str = "[0; 1] (after 64 shrink steps)" in
+    let run_test () =
+      check_exn
+        QCheck2.(Test.make ~name ~print:Print.(list int)
+                           Gen.(list int) (fun l -> List.rev l = l)) in
+    Alcotest.check_raises "Fail" (Test.Test_fail (name,[counterex_str])) run_test
+
+  exception Error
+
+  let test_error () =
+    let name = "will-always-error" in
+    let counterex_str = "0 (after 2 shrink steps)" in
+    let run_test () =
+      check_exn QCheck2.(Test.make ~name ~print:Print.int Gen.int (fun _ -> raise Error)) in
+    Alcotest.check_raises "Error" (Test.Test_error (name,counterex_str,Error,"")) run_test
+
+  let tests =
+    ("Test.check_exn", Alcotest.[
+         test_case "check_exn pass trivial" `Quick test_pass_trivial;
+         test_case "check_exn pass random" `Quick test_pass_random;
+         test_case "check_exn fail always" `Quick test_fail_always;
+         test_case "check_exn fail random" `Quick test_fail_random;
+         test_case "check_exn Error" `Quick test_error;
+       ])
+end
+
 let () =
-  Alcotest.run "QCheck"
+  Alcotest.run "QCheck2"
     [
       Shrink.tests;
       Gen.tests;
-      Test.tests;
-      String.tests
+      TestCount.tests;
+      String.tests;
+      Check_exn.tests;
     ]