diff --git a/test/core/qcheck2_output.txt.expected b/test/core/QCheck2_expect_test.expected similarity index 84% rename from test/core/qcheck2_output.txt.expected rename to test/core/QCheck2_expect_test.expected index efe05edb..4e3b8b65 100644 --- a/test/core/qcheck2_output.txt.expected +++ b/test/core/QCheck2_expect_test.expected @@ -312,6 +312,108 @@ Test string never has a \255 char failed (59 shrink steps): --- Failure -------------------------------------------------------------------- +Test pairs have different components failed (0 shrink steps): + +(4, 4) + +--- Failure -------------------------------------------------------------------- + +Test pairs have same components failed (63 shrink steps): + +(0, 1) + +--- Failure -------------------------------------------------------------------- + +Test pairs have a zero component failed (122 shrink steps): + +(1, 1) + +--- Failure -------------------------------------------------------------------- + +Test pairs are (0,0) failed (63 shrink steps): + +(0, 1) + +--- Failure -------------------------------------------------------------------- + +Test pairs are ordered failed (2 shrink steps): + +(0, -1) + +--- Failure -------------------------------------------------------------------- + +Test pairs are ordered reversely failed (63 shrink steps): + +(0, 1) + +--- Failure -------------------------------------------------------------------- + +Test pairs sum to less than 128 failed (59 shrink steps): + +(0, 128) + +--- Failure -------------------------------------------------------------------- + +Test triples have pair-wise different components failed (3 shrink steps): + +(0, 0, 0) + +--- Failure -------------------------------------------------------------------- + +Test triples have same components failed (64 shrink steps): + +(0, 1, 0) + +--- Failure -------------------------------------------------------------------- + +Test triples are ordered failed (3 shrink steps): + +(0, -1, 0) + +--- Failure -------------------------------------------------------------------- + +Test triples are ordered reversely failed (64 shrink steps): + +(0, 0, 1) + +--- Failure -------------------------------------------------------------------- + +Test quadruples have pair-wise different components failed (4 shrink steps): + +(0, 0, 0, 0) + +--- Failure -------------------------------------------------------------------- + +Test quadruples have same components failed (126 shrink steps): + +(0, 1, 0, 1) + +--- Failure -------------------------------------------------------------------- + +Test quadruples are ordered failed (5 shrink steps): + +(0, 0, -1, 0) + +--- Failure -------------------------------------------------------------------- + +Test quadruples are ordered reversely failed (66 shrink steps): + +(0, 0, 0, 1) + +--- Failure -------------------------------------------------------------------- + +Test bind ordered pairs failed (1 shrink steps): + +(0, 0) + +--- Failure -------------------------------------------------------------------- + +Test bind list_size constant failed (15 shrink steps): + +(4, [0; 0; 0; 0]) + +--- Failure -------------------------------------------------------------------- + Test lists are empty failed (8 shrink steps): [0] @@ -614,6 +716,132 @@ stats len: 90.. 94: # 60 95.. 99: # 62 ++++ Stats for pair dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +stats pair sum: + num: 500000, avg: 100.02, stddev: 41.22, median 100, min 0, max 200 + 0.. 9: ### 2685 + 10.. 19: ######## 7622 + 20.. 29: ############## 12474 + 30.. 39: #################### 17330 + 40.. 49: ########################## 22263 + 50.. 59: ############################### 26982 + 60.. 69: ##################################### 32182 + 70.. 79: ########################################### 37125 + 80.. 89: ################################################# 42287 + 90.. 99: ###################################################### 46691 + 100..109: ####################################################### 46977 + 110..119: ################################################# 42444 + 120..129: ############################################ 37719 + 130..139: ###################################### 32595 + 140..149: ################################ 27588 + 150..159: ########################## 22792 + 160..169: #################### 17805 + 170..179: ############### 13068 + 180..189: ######### 8218 + 190..199: ### 3115 + 200..209: 38 + ++++ Stats for triple dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +stats triple sum: + num: 500000, avg: 150.08, stddev: 50.51, median 150, min 0, max 299 + 0.. 14: 345 + 15.. 29: ## 2121 + 30.. 44: ##### 5372 + 45.. 59: ########## 10501 + 60.. 74: ################# 17031 + 75.. 89: ######################### 25417 + 90..104: ################################### 35148 + 105..119: ############################################# 45134 + 120..134: ################################################### 51751 + 135..149: ####################################################### 55090 + 150..164: ###################################################### 55074 + 165..179: #################################################### 52238 + 180..194: ############################################# 45651 + 195..209: ################################### 35994 + 210..224: ######################### 26039 + 225..239: ################# 17749 + 240..254: ########## 10870 + 255..269: ##### 5765 + 270..284: ## 2313 + 285..299: 397 + ++++ Stats for quad dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +stats quad sum: + num: 500000, avg: 200.13, stddev: 58.33, median 200, min 5, max 394 + 5.. 24: 102 + 25.. 44: 842 + 45.. 64: ## 3023 + 65.. 84: ###### 7154 + 85..104: ############ 14368 + 105..124: ##################### 25397 + 125..144: ############################### 37547 + 145..164: ########################################## 50174 + 165..184: ################################################## 60558 + 185..204: ####################################################### 65376 + 205..224: ##################################################### 63687 + 225..244: ############################################### 56248 + 245..264: ###################################### 45384 + 265..284: ########################## 31780 + 285..304: ################ 20158 + 305..324: ######### 10899 + 325..344: #### 5045 + 345..364: # 1848 + 365..384: 386 + 385..404: 24 + ++++ Stats for bind dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +stats ordered pair difference: + num: 1000000, avg: 25.02, stddev: 22.36, median 19, min 0, max 100 + 0.. 4: ####################################################### 193184 + 5.. 9: ##################################### 130024 + 10.. 14: ############################# 103828 + 15.. 19: ######################## 87496 + 20.. 24: ##################### 74431 + 25.. 29: ################## 64629 + 30.. 34: ################ 56663 + 35.. 39: ############# 48986 + 40.. 44: ############ 43424 + 45.. 49: ########## 37599 + 50.. 54: ######### 32787 + 55.. 59: ######## 28332 + 60.. 64: ###### 24023 + 65.. 69: ##### 20312 + 70.. 74: #### 16649 + 75.. 79: ### 13338 + 80.. 84: ## 10239 + 85.. 89: ## 7391 + 90.. 94: # 4548 + 95.. 99: 2015 + 100..104: 102 + +stats ordered pair sum: + num: 1000000, avg: 75.12, stddev: 46.93, median 72, min 0, max 200 + 0.. 9: ####################################################### 70423 + 10.. 19: ##################################################### 68068 + 20.. 29: ##################################################### 68449 + 30.. 39: ##################################################### 68577 + 40.. 49: ##################################################### 68763 + 50.. 59: ##################################################### 68351 + 60.. 69: ##################################################### 68744 + 70.. 79: ##################################################### 68451 + 80.. 89: ##################################################### 68309 + 90.. 99: ##################################################### 68835 + 100..109: ################################################## 64544 + 110..119: ########################################### 55512 + 120..129: ##################################### 47595 + 130..139: ############################### 39809 + 140..149: ######################### 32677 + 150..159: #################### 26312 + 160..169: ############### 20180 + 170..179: ########### 14265 + 180..189: ###### 8625 + 190..199: ## 3433 + 200..209: 78 + +++ Stats for list len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats len: @@ -988,7 +1216,7 @@ stats dist: 4150517416584649600.. 4611686018427387903: ################# 189 ================================================================================ 1 warning(s) -failure (36 tests failed, 1 tests errored, ran 84 tests) +failure (53 tests failed, 1 tests errored, ran 110 tests) random seed: 153870556 +++ Stats for int_dist_empty_bucket ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ diff --git a/test/core/QCheck2_expect_test.ml b/test/core/QCheck2_expect_test.ml index 91e82e3c..3c955b3c 100644 --- a/test/core/QCheck2_expect_test.ml +++ b/test/core/QCheck2_expect_test.ml @@ -124,6 +124,32 @@ module Generator = struct && String.to_seq s |> Seq.fold_left (fun acc c -> acc && '\000' <= c && c <= '\255') true) + let pair_test = + Test.make ~name:"int pairs - commute over +" ~count:1000 ~print:Print.(pair int int) + Gen.(pair small_nat small_nat) (fun (i,j) -> i+j = j+i) + + let triple_test = + Test.make ~name:"int triples - associative over +" ~count:1000 + ~print:Print.(triple int int int) + Gen.(triple small_nat small_nat small_nat) (fun (i,j,k) -> i+(j+k) = (i+j)+k) + (*was: (fun (i,j,k) -> i+(j+k) = (i+j)+i)*) + + let quad_test = + Test.make ~name:"int quadruples - product of sums" ~count:1000 + ~print:Print.(quad int int int int) + Gen.(quad small_nat small_nat small_nat small_nat) + (fun (h,i,j,k) -> (h+i)*(j+k) = h*j + h*k + i*j + i*k) + + let bind_test = + Test.make ~name:"bind test for ordered pairs" ~count:1000 ~print:Print.(pair int int) + Gen.(small_nat >>= fun j -> int_bound j >>= fun i -> return (i,j)) + (fun (i,j) -> i<=j) + + let bind_pair_list_length = + Test.make ~name:"bind list length" ~count:1000 ~print:Print.(pair int (list int)) + Gen.(int_bound 10_000 >>= fun len -> list_size (return len) int >>= fun xs -> return (len,xs)) + (fun (len,xs) -> len = List.length xs) + let list_test = Test.make ~name:"list has right length" ~count:1000 ~print:Print.(list unit) @@ -142,8 +168,7 @@ module Generator = struct (fun (i,l) -> Array.length l = i) let passing_tree_rev = - Test.make ~count:1000 - ~name:"tree_rev_is_involutive" + Test.make ~name:"tree_rev_is_involutive" ~count:1000 IntTree.gen_tree (fun tree -> IntTree.(rev_tree (rev_tree tree)) = tree) @@ -206,6 +231,11 @@ module Generator = struct char_test; nat_test; string_test; + pair_test; + triple_test; + quad_test; + bind_test; + bind_pair_list_length; list_test; list_repeat_test; array_repeat_test; @@ -248,6 +278,7 @@ module Shrink = struct (Gen.pair listgen listgen) (fun (xs,ys) -> List.rev (xs@ys) = (List.rev xs)@(List.rev ys)) + (* test from issue #36 *) let ints_arent_0_mod_3 = Test.make ~name:"ints arent 0 mod 3" ~count:1000 ~print:Print.int Gen.int (fun i -> i mod 3 <> 0) @@ -283,6 +314,78 @@ module Shrink = struct Gen.string (fun s -> String.to_seq s |> Seq.fold_left (fun acc c -> acc && c <> '\255') true) + (* test from issue #167 *) + let pair_diff_issue_64 = + Test.make ~name:"pairs have different components" ~print:Print.(pair int int) + Gen.(pair small_int small_int) (fun (i,j) -> i<>j) + + let pair_same = + Test.make ~name:"pairs have same components" ~print:Print.(pair int int) + Gen.(pair int int) (fun (i,j) -> i=j) + + let pair_one_zero = + Test.make ~name:"pairs have a zero component" ~print:Print.(pair int int) + Gen.(pair int int) (fun (i,j) -> i=0 || j=0) + + let pair_all_zero = + Test.make ~name:"pairs are (0,0)" ~print:Print.(pair int int) + Gen.(pair int int) (fun (i,j) -> i=0 && j=0) + + let pair_ordered = + Test.make ~name:"pairs are ordered" ~print:Print.(pair int int) + Gen.(pair int int) (fun (i,j) -> i<=j) + + let pair_ordered_rev = + Test.make ~name:"pairs are ordered reversely" ~print:Print.(pair int int) + Gen.(pair int int) (fun (i,j) -> i>=j) + + let pair_sum_lt_128 = + Test.make ~name:"pairs sum to less than 128" ~print:Print.(pair int int) + Gen.(pair int int) (fun (i,j) -> i+j<128) + + let triple_diff = + Test.make ~name:"triples have pair-wise different components" ~print:Print.(triple int int int) + Gen.(triple small_int small_int small_int) (fun (i,j,k) -> i<>j && j<>k) + + let triple_same = + Test.make ~name:"triples have same components" ~print:Print.(triple int int int) + Gen.(triple int int int) (fun (i,j,k) -> i=j || j=k) + + let triple_ordered = + Test.make ~name:"triples are ordered" ~print:Print.(triple int int int) + Gen.(triple int int int) (fun (i,j,k) -> i<=j && j<=k) + + let triple_ordered_rev = + Test.make ~name:"triples are ordered reversely" ~print:Print.(triple int int int) + Gen.(triple int int int) (fun (i,j,k) -> i>=j && j>=k) + + let quad_diff = + Test.make ~name:"quadruples have pair-wise different components" ~print:Print.(quad int int int int) + Gen.(quad small_int small_int small_int small_int) (fun (h,i,j,k) -> h<>i && i<>j && j<>k) + + let quad_same = + Test.make ~name:"quadruples have same components" ~print:Print.(quad int int int int) + Gen.(quad int int int int) (fun (h,i,j,k) -> h=i || i=j || j=k) + + let quad_ordered = + Test.make ~name:"quadruples are ordered" ~print:Print.(quad int int int int) + Gen.(quad int int int int) (fun (h,i,j,k) -> h <= i && i <= j && j <= k) + + let quad_ordered_rev = + Test.make ~name:"quadruples are ordered reversely" ~print:Print.(quad int int int int) + Gen.(quad int int int int) (fun (h,i,j,k) -> h >= i && i >= j && j >= k) + + let bind_pair_ordered = + Test.make ~name:"bind ordered pairs" ~print:Print.(pair int int) + Gen.(int >>= fun j -> int_bound j >>= fun i -> return (i,j)) + (fun (_i,_j) -> false) + + let bind_pair_list_size = + Test.make ~name:"bind list_size constant" ~print:Print.(pair int (list int)) + Gen.(int_bound 10_000 >>= fun len -> + list_size (return len) int >>= fun xs -> return (len,xs)) + (fun (len,xs) -> let len' = List.length xs in len=len' && len' < 4) + (* tests from issue #64 *) let print_list xs = print_endline Print.(list int xs) @@ -394,6 +497,23 @@ module Shrink = struct strings_are_empty; string_never_has_000_char; string_never_has_255_char; + pair_diff_issue_64; + pair_same; + pair_one_zero; + pair_all_zero; + pair_ordered; + pair_ordered_rev; + pair_sum_lt_128; + triple_diff; + triple_same; + triple_ordered; + triple_ordered_rev; + quad_diff; + quad_same; + quad_ordered; + quad_ordered_rev; + bind_pair_ordered; + bind_pair_list_size; lists_are_empty_issue_64; list_shorter_10; list_shorter_432; @@ -548,6 +668,23 @@ module Stats = struct Test.make ~name:"small_string len dist" ~count:5_000 ~stats:[len] Gen.(small_string ~gen:char)(*ugh*)(fun _ -> true); ] + let pair_dist = + Test.make ~name:"pair dist" ~count:500_000 ~stats:[("pair sum", (fun (i,j) -> i+j))] + Gen.(pair (int_bound 100) (int_bound 100)) (fun _ -> true) + + let triple_dist = + Test.make ~name:"triple dist" ~count:500_000 ~stats:[("triple sum", (fun (i,j,k) -> i+j+k))] + Gen.(triple (int_bound 100) (int_bound 100) (int_bound 100)) (fun _ -> true) + + let quad_dist = + Test.make ~name:"quad dist" ~count:500_000 ~stats:[("quad sum", (fun (h,i,j,k) -> h+i+j+k))] + Gen.(quad (int_bound 100) (int_bound 100) (int_bound 100) (int_bound 100)) (fun _ -> true) + + let bind_dist = + Test.make ~name:"bind dist" ~count:1_000_000 + ~stats:[("ordered pair difference", (fun (i,j) -> j-i));("ordered pair sum", (fun (i,j) -> i+j))] + Gen.(int_bound 100 >>= fun j -> int_bound j >>= fun i -> return (i,j)) (fun _ -> true) + let list_len_tests = let len = ("len",List.length) in [ (* test from issue #30 *) @@ -598,6 +735,10 @@ module Stats = struct tree_depth_test ] @ string_len_tests + @ [pair_dist; + triple_dist; + quad_dist; + bind_dist;] @ list_len_tests @ array_len_tests @ int_dist_tests diff --git a/test/core/test.ml b/test/core/QCheck2_unit_tests.ml similarity index 71% rename from test/core/test.ml rename to test/core/QCheck2_unit_tests.ml index 8641e8c9..cfbc02f2 100644 --- a/test/core/test.ml +++ b/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,61 @@ 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 MyError + + let test_error () = + let name = "will-always-error" in + let counterex_str = "0 (after 2 shrink steps)" in + let run_test () = + let () = Printexc.record_backtrace false in (* for easier pattern-matching below *) + check_exn QCheck2.(Test.make ~name ~print:Print.int Gen.int (fun _ -> raise MyError)) in + Alcotest.check_raises "MyError" (Test.Test_error (name,counterex_str,MyError,"")) 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; ] diff --git a/test/core/qcheck_output.txt.expected b/test/core/QCheck_expect_test.expected similarity index 82% rename from test/core/qcheck_output.txt.expected rename to test/core/QCheck_expect_test.expected index 880df258..74b8a220 100644 --- a/test/core/qcheck_output.txt.expected +++ b/test/core/QCheck_expect_test.expected @@ -247,6 +247,108 @@ Test string never has a \255 char failed (249 shrink steps): --- Failure -------------------------------------------------------------------- +Test pairs have different components failed (0 shrink steps): + +(4, 4) + +--- Failure -------------------------------------------------------------------- + +Test pairs have same components failed (125 shrink steps): + +(0, 1) + +--- Failure -------------------------------------------------------------------- + +Test pairs have a zero component failed (124 shrink steps): + +(-1, 1) + +--- Failure -------------------------------------------------------------------- + +Test pairs are (0,0) failed (125 shrink steps): + +(0, 1) + +--- Failure -------------------------------------------------------------------- + +Test pairs are ordered failed (125 shrink steps): + +(0, -1) + +--- Failure -------------------------------------------------------------------- + +Test pairs are ordered reversely failed (125 shrink steps): + +(0, 1) + +--- Failure -------------------------------------------------------------------- + +Test pairs sum to less than 128 failed (121 shrink steps): + +(0, 128) + +--- Failure -------------------------------------------------------------------- + +Test triples have pair-wise different components failed (7 shrink steps): + +(0, 7, 7) + +--- Failure -------------------------------------------------------------------- + +Test triples have same components failed (188 shrink steps): + +(0, -1, 0) + +--- Failure -------------------------------------------------------------------- + +Test triples are ordered failed (188 shrink steps): + +(0, -1, 0) + +--- Failure -------------------------------------------------------------------- + +Test triples are ordered reversely failed (188 shrink steps): + +(0, 0, 1) + +--- Failure -------------------------------------------------------------------- + +Test quadruples have pair-wise different components failed (23 shrink steps): + +(0, 0, 0, 0) + +--- Failure -------------------------------------------------------------------- + +Test quadruples have same components failed (250 shrink steps): + +(0, 1, 0, 1) + +--- Failure -------------------------------------------------------------------- + +Test quadruples are ordered failed (251 shrink steps): + +(0, 0, -1, 0) + +--- Failure -------------------------------------------------------------------- + +Test quadruples are ordered reversely failed (251 shrink steps): + +(0, 0, 0, 1) + +--- Failure -------------------------------------------------------------------- + +Test bind ordered pairs failed (123 shrink steps): + +(0, 0) + +--- Failure -------------------------------------------------------------------- + +Test bind list_size constant failed (261 shrink steps): + +(4, [0; 0; 0; 0]) + +--- Failure -------------------------------------------------------------------- + Test lists are empty failed (11 shrink steps): [0] @@ -331,6 +433,12 @@ Test forall (a, b, c, d, e, f, g, h, i) in nat: a < b < c < d < e < f < g < h < --- Failure -------------------------------------------------------------------- +Test tree contains only 42 failed (10 shrink steps): + +Leaf 0 + +--- Failure -------------------------------------------------------------------- + Test fail_pred_map_commute failed (127 shrink steps): ([3], {_ -> 0}, {3 -> false; _ -> true}) @@ -569,6 +677,132 @@ stats len: 90.. 94: # 60 95.. 99: # 62 ++++ Stats for pair dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +stats pair sum: + num: 500000, avg: 100.02, stddev: 41.22, median 100, min 0, max 200 + 0.. 9: ### 2685 + 10.. 19: ######## 7622 + 20.. 29: ############## 12474 + 30.. 39: #################### 17330 + 40.. 49: ########################## 22263 + 50.. 59: ############################### 26982 + 60.. 69: ##################################### 32182 + 70.. 79: ########################################### 37125 + 80.. 89: ################################################# 42287 + 90.. 99: ###################################################### 46691 + 100..109: ####################################################### 46977 + 110..119: ################################################# 42444 + 120..129: ############################################ 37719 + 130..139: ###################################### 32595 + 140..149: ################################ 27588 + 150..159: ########################## 22792 + 160..169: #################### 17805 + 170..179: ############### 13068 + 180..189: ######### 8218 + 190..199: ### 3115 + 200..209: 38 + ++++ Stats for triple dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +stats triple sum: + num: 500000, avg: 150.08, stddev: 50.51, median 150, min 0, max 299 + 0.. 14: 345 + 15.. 29: ## 2121 + 30.. 44: ##### 5372 + 45.. 59: ########## 10501 + 60.. 74: ################# 17031 + 75.. 89: ######################### 25417 + 90..104: ################################### 35148 + 105..119: ############################################# 45134 + 120..134: ################################################### 51751 + 135..149: ####################################################### 55090 + 150..164: ###################################################### 55074 + 165..179: #################################################### 52238 + 180..194: ############################################# 45651 + 195..209: ################################### 35994 + 210..224: ######################### 26039 + 225..239: ################# 17749 + 240..254: ########## 10870 + 255..269: ##### 5765 + 270..284: ## 2313 + 285..299: 397 + ++++ Stats for quad dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +stats quad sum: + num: 500000, avg: 200.13, stddev: 58.33, median 200, min 5, max 394 + 5.. 24: 102 + 25.. 44: 842 + 45.. 64: ## 3023 + 65.. 84: ###### 7154 + 85..104: ############ 14368 + 105..124: ##################### 25397 + 125..144: ############################### 37547 + 145..164: ########################################## 50174 + 165..184: ################################################## 60558 + 185..204: ####################################################### 65376 + 205..224: ##################################################### 63687 + 225..244: ############################################### 56248 + 245..264: ###################################### 45384 + 265..284: ########################## 31780 + 285..304: ################ 20158 + 305..324: ######### 10899 + 325..344: #### 5045 + 345..364: # 1848 + 365..384: 386 + 385..404: 24 + ++++ Stats for bind dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +stats ordered pair difference: + num: 1000000, avg: 25.02, stddev: 22.36, median 19, min 0, max 100 + 0.. 4: ####################################################### 193184 + 5.. 9: ##################################### 130024 + 10.. 14: ############################# 103828 + 15.. 19: ######################## 87496 + 20.. 24: ##################### 74431 + 25.. 29: ################## 64629 + 30.. 34: ################ 56663 + 35.. 39: ############# 48986 + 40.. 44: ############ 43424 + 45.. 49: ########## 37599 + 50.. 54: ######### 32787 + 55.. 59: ######## 28332 + 60.. 64: ###### 24023 + 65.. 69: ##### 20312 + 70.. 74: #### 16649 + 75.. 79: ### 13338 + 80.. 84: ## 10239 + 85.. 89: ## 7391 + 90.. 94: # 4548 + 95.. 99: 2015 + 100..104: 102 + +stats ordered pair sum: + num: 1000000, avg: 75.12, stddev: 46.93, median 72, min 0, max 200 + 0.. 9: ####################################################### 70423 + 10.. 19: ##################################################### 68068 + 20.. 29: ##################################################### 68449 + 30.. 39: ##################################################### 68577 + 40.. 49: ##################################################### 68763 + 50.. 59: ##################################################### 68351 + 60.. 69: ##################################################### 68744 + 70.. 79: ##################################################### 68451 + 80.. 89: ##################################################### 68309 + 90.. 99: ##################################################### 68835 + 100..109: ################################################## 64544 + 110..119: ########################################### 55512 + 120..129: ##################################### 47595 + 130..139: ############################### 39809 + 140..149: ######################### 32677 + 150..159: #################### 26312 + 160..169: ############### 20180 + 170..179: ########### 14265 + 180..189: ###### 8625 + 190..199: ## 3433 + 200..209: 78 + +++ Stats for list len dist ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stats len: @@ -943,7 +1177,7 @@ stats dist: 4150517416584649600.. 4611686018427387903: ################# 189 ================================================================================ 1 warning(s) -failure (35 tests failed, 1 tests errored, ran 90 tests) +failure (53 tests failed, 1 tests errored, ran 117 tests) random seed: 153870556 +++ Stats for int_dist_empty_bucket ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ diff --git a/test/core/QCheck_expect_test.ml b/test/core/QCheck_expect_test.ml index b642e6fb..6c43d0c3 100644 --- a/test/core/QCheck_expect_test.ml +++ b/test/core/QCheck_expect_test.ml @@ -2,6 +2,8 @@ (** Module representing a tree data structure, used in tests *) module IntTree = struct + open QCheck + type tree = Leaf of int | Node of tree * tree let leaf x = Leaf x @@ -15,7 +17,7 @@ module IntTree = struct | Leaf x -> Printf.sprintf "Leaf %d" x | Node (x, y) -> Printf.sprintf "Node (%s, %s)" (print_tree x) (print_tree y) - let gen_tree = QCheck.Gen.(sized @@ fix + let gen_tree = Gen.(sized @@ fix (fun self n -> match n with | 0 -> map leaf nat | n -> @@ -24,15 +26,21 @@ module IntTree = struct 2, map2 node (self (n/2)) (self (n/2))] )) + let rec shrink_tree t = match t with + | Leaf l -> Iter.map (fun l' -> Leaf l') (Shrink.int l) + | Node (x,y) -> + let open Iter in + of_list [x;y] + <+> map (fun x' -> Node (x',y)) (shrink_tree x) + <+> map (fun y' -> Node (x,y')) (shrink_tree y) + let rec rev_tree = function | Node (x, y) -> Node (rev_tree y, rev_tree x) | Leaf x -> Leaf x - let passing_tree_rev = - QCheck.Test.make ~count:1000 - ~name:"tree_rev_is_involutive" - QCheck.(make gen_tree) - (fun tree -> rev_tree (rev_tree tree) = tree) + let rec contains_only_n tree n = match tree with + | Leaf n' -> n = n' + | Node (x, y) -> contains_only_n x n && contains_only_n y n end (* tests of overall functionality *) @@ -132,6 +140,30 @@ module Generator = struct && String.to_seq s |> Seq.fold_left (fun acc c -> acc && '\000' <= c && c <= '\255') true) + let pair_test = + Test.make ~name:"int pairs - commute over +" ~count:1000 + (pair small_nat small_nat) (fun (i,j) -> i+j = j+i) + + let triple_test = + Test.make ~name:"int triples - associative over +" ~count:1000 + (triple small_nat small_nat small_nat) (fun (i,j,k) -> i+(j+k) = (i+j)+k) + (*was: (fun (i,j,k) -> i+(j+k) = (i+j)+i)*) + + let quad_test = + Test.make ~name:"int quadruples - product of sums" ~count:1000 + (quad small_nat small_nat small_nat small_nat) + (fun (h,i,j,k) -> (h+i)*(j+k) = h*j + h*k + i*j + i*k) + + let bind_test = + Test.make ~name:"bind test for ordered pairs" ~count:1000 + (make Gen.(small_nat >>= fun j -> int_bound j >>= fun i -> return (i,j))) + (fun (i,j) -> i<=j) + + let bind_pair_list_length = + Test.make ~name:"bind list length" ~count:1000 + (make Gen.(int_bound 10_000 >>= fun len -> list_size (return len) int >>= fun xs -> return (len,xs))) + (fun (len,xs) -> len = List.length xs) + let list_test = Test.make ~name:"list has right length" ~count:1000 (list unit) (fun l -> let len = List.length l in 0 <= len && len < 10_000) @@ -147,9 +179,8 @@ module Generator = struct (make ~print:Print.(pair int (array unit)) gen) (fun (i,l) -> Array.length l = i) let passing_tree_rev = - QCheck.Test.make ~count:1000 - ~name:"tree_rev_is_involutive" - QCheck.(make IntTree.gen_tree) + Test.make ~name:"tree_rev_is_involutive" ~count:1000 + (make IntTree.gen_tree) (fun tree -> IntTree.(rev_tree (rev_tree tree)) = tree) let nat_split2_spec = @@ -287,6 +318,11 @@ module Generator = struct char_test; nat_test; string_test; + pair_test; + triple_test; + quad_test; + bind_test; + bind_pair_list_length; list_test; list_repeat_test; array_repeat_test; @@ -334,6 +370,7 @@ module Shrink = struct Test.make ~name:"long_shrink" (pair listgen listgen) (fun (xs,ys) -> List.rev (xs@ys) = (List.rev xs)@(List.rev ys)) + (* test from issue 36 *) let ints_arent_0_mod_3 = Test.make ~name:"ints arent 0 mod 3" ~count:1000 int (fun i -> i mod 3 <> 0) @@ -369,7 +406,79 @@ module Shrink = struct string (fun s -> String.to_seq s |> Seq.fold_left (fun acc c -> acc && c <> '\255') true) + (* test from issue #167 *) + let pair_diff_issue_64 = + Test.make ~name:"pairs have different components" + (pair small_int small_int) (fun (i,j) -> i<>j) + + let pair_same = + Test.make ~name:"pairs have same components" (pair int int) (fun (i,j) -> i=j) + + let pair_one_zero = + Test.make ~name:"pairs have a zero component" (pair int int) (fun (i,j) -> i=0 || j=0) + + let pair_all_zero = + Test.make ~name:"pairs are (0,0)" (pair int int) (fun (i,j) -> i=0 && j=0) + + let pair_ordered = + Test.make ~name:"pairs are ordered" (pair int int) (fun (i,j) -> i<=j) + + let pair_ordered_rev = + Test.make ~name:"pairs are ordered reversely" (pair int int) (fun (i,j) -> i>=j) + + let pair_sum_lt_128 = + Test.make ~name:"pairs sum to less than 128" (pair int int) (fun (i,j) -> i+j<128) + + let triple_diff = + Test.make ~name:"triples have pair-wise different components" + (triple small_int small_int small_int) (fun (i,j,k) -> i<>j && j<>k) + + let triple_same = + Test.make ~name:"triples have same components" + (triple int int int) (fun (i,j,k) -> i=j || j=k) + + let triple_ordered = + Test.make ~name:"triples are ordered" + (triple int int int) (fun (i,j,k) -> i<=j && j<=k) + + let triple_ordered_rev = + Test.make ~name:"triples are ordered reversely" + (triple int int int) (fun (i,j,k) -> i>=j && j>=k) + + let quad_diff = + Test.make ~name:"quadruples have pair-wise different components" + (quad small_int small_int small_int small_int) (fun (h,i,j,k) -> h<>i && i<>j && j<>k) + + let quad_same = + Test.make ~name:"quadruples have same components" + (quad int int int int) (fun (h,i,j,k) -> h=i || i=j || j=k) + + let quad_ordered = + Test.make ~name:"quadruples are ordered" + (quad int int int int) (fun (h,i,j,k) -> h <= i && i <= j && j <= k) + + let quad_ordered_rev = + Test.make ~name:"quadruples are ordered reversely" + (quad int int int int) (fun (h,i,j,k) -> h >= i && i >= j && j >= k) + + let bind_pair_ordered = + Test.make ~name:"bind ordered pairs" + (make ~print:Print.(pair int int) + ~shrink:Shrink.(filter (fun (i,j) -> i<=j) (pair int int)) + Gen.(int >>= fun j -> int_bound j >>= fun i -> return (i,j))) + (fun (_i,_j) -> false) + + let bind_pair_list_size = + let shrink (_l,xs) = + Iter.map (fun xs' -> (List.length xs',xs')) Shrink.(list ~shrink:int xs) in + Test.make ~name:"bind list_size constant" + (make ~print:Print.(pair int (list int)) ~shrink + Gen.(int_bound 10_000 >>= fun len -> + list_size (return len) int >>= fun xs -> return (len,xs))) + (fun (len,xs) -> let len' = List.length xs in len=len' && len' < 4) + let print_list xs = print_endline Print.(list int xs) + (* test from issue #64 *) let lists_are_empty_issue_64 = Test.make ~name:"lists are empty" @@ -454,6 +563,11 @@ module Shrink = struct (tup9 small_int small_int small_int small_int small_int small_int small_int small_int small_int) (fun (a, b, c, d, e, f, g, h, i) -> a < b && b < c && c < d && d < e && e < f && f < g && g < h && h < i) + let tree_contains_only_42 = + Test.make ~name:"tree contains only 42" + IntTree.(make ~print:print_tree ~shrink:shrink_tree gen_tree) + (fun tree -> IntTree.contains_only_n tree 42) + let tests = [ (*test_fac_issue59;*) big_bound_issue59; @@ -466,6 +580,23 @@ module Shrink = struct strings_are_empty; string_never_has_000_char; string_never_has_255_char; + pair_diff_issue_64; + pair_same; + pair_one_zero; + pair_all_zero; + pair_ordered; + pair_ordered_rev; + pair_sum_lt_128; + triple_diff; + triple_same; + triple_ordered; + triple_ordered_rev; + quad_diff; + quad_same; + quad_ordered; + quad_ordered_rev; + bind_pair_ordered; + bind_pair_list_size; lists_are_empty_issue_64; list_shorter_10; list_shorter_432; @@ -480,6 +611,7 @@ module Shrink = struct test_tup7; test_tup8; test_tup9; + tree_contains_only_42; ] end @@ -614,6 +746,26 @@ module Stats = struct Test.make ~name:"small_string len dist" ~count:5_000 (add_stat len small_string) (fun _ -> true); ] + let pair_dist = + Test.make ~name:"pair dist" ~count:500_000 + (add_stat ("pair sum", (fun (i,j) -> i+j)) + (pair (int_bound 100) (int_bound 100))) (fun _ -> true) + + let triple_dist = + Test.make ~name:"triple dist" ~count:500_000 + (add_stat ("triple sum", (fun (i,j,k) -> i+j+k)) + (triple (int_bound 100) (int_bound 100) (int_bound 100))) (fun _ -> true) + + let quad_dist = + Test.make ~name:"quad dist" ~count:500_000 + (add_stat ("quad sum", (fun (h,i,j,k) -> h+i+j+k)) + (quad (int_bound 100) (int_bound 100) (int_bound 100) (int_bound 100))) (fun _ -> true) + + let bind_dist = + Test.make ~name:"bind dist" ~count:1_000_000 + (make ~stats:[("ordered pair difference", (fun (i,j) -> j-i));("ordered pair sum", (fun (i,j) -> i+j))] + Gen.(int_bound 100 >>= fun j -> int_bound j >>= fun i -> return (i,j))) (fun _ -> true) + let list_len_tests = let len = ("len",List.length) in [ (* test from issue #30 *) @@ -669,6 +821,10 @@ module Stats = struct range_subset_test ] @ string_len_tests + @ [pair_dist; + triple_dist; + quad_dist; + bind_dist;] @ list_len_tests @ array_len_tests @ int_dist_tests diff --git a/test/core/QCheck_unit_tests.ml b/test/core/QCheck_unit_tests.ml new file mode 100644 index 00000000..9ace8fce --- /dev/null +++ b/test/core/QCheck_unit_tests.ml @@ -0,0 +1,110 @@ +open QCheck + +module Shrink = struct + + let trace_false shrinker x = + let res = ref [] in + shrinker x (fun x -> res := x::!res); + List.rev !res + + let trace_true shrinker x = + let rec loop x = + match Iter.find (fun _ -> true) (shrinker x) with + | None -> [] + | Some y -> y::loop y in + loop x + + let alco_check typ func msg_suffix (msg,input,expected) = + Alcotest.(check (list typ)) (msg ^ " - " ^ msg_suffix) (func input) expected + + let test_int () = + List.iter (alco_check Alcotest.int (trace_false Shrink.int) "on repeated failure") + [ ("int 100", 100, [50; 75; 88; 94; 97; 99; 99]); (*WTF?*) + ("int 1000", 1000, [500; 750; 875; 938; 969; 985; 993; 997; 999; 999]); (*WTF?*) + ("int (-26)", -26, [-13; -20; -23; -25; -25]) ]; (*WTF?*) + List.iter (alco_check Alcotest.int (trace_true Shrink.int) "on repeated success") + [ ("int 100", 100, [50; 25; 13; 7; 4; 2; 1; 0]); + ("int 1000", 1000, [500; 250; 125; 63; 32; 16; 8; 4; 2; 1; 0]); + ("int (-26)", -26, [-13; -7; -4; -2; -1; 0]) ] + + let test_int32 () = + List.iter (alco_check Alcotest.int32 (trace_false Shrink.int32) "on repeated failure") + [ ("int 100", 100l, [50l; 75l; 88l; 94l; 97l; 99l; 99l]); + ("int 1000", 1000l, [500l; 750l; 875l; 938l; 969l; 985l; 993l; 997l; 999l; 999l]); + ("int (-26)", -26l, [-13l; -20l; -23l; -25l; -25l]) ]; + List.iter (alco_check Alcotest.int32 (trace_true Shrink.int32) "on repeated success") + [ ("int 100", 100l, [50l; 25l; 13l; 7l; 4l; 2l; 1l; 0l]); + ("int 1000", 1000l, [500l; 250l; 125l; 63l; 32l; 16l; 8l; 4l; 2l; 1l; 0l]); + ("int (-26)", -26l, [-13l; -7l; -4l; -2l; -1l; 0l]) ] + + let test_int64 () = + List.iter (alco_check Alcotest.int64 (trace_false Shrink.int64) "on repeated failure") + [ ("int 100", 100L, [50L; 75L; 88L; 94L; 97L; 99L; 99L]); + ("int 1000", 1000L, [500L; 750L; 875L; 938L; 969L; 985L; 993L; 997L; 999L; 999L]); + ("int (-26)", -26L, [-13L; -20L; -23L; -25L; -25L]) ]; + List.iter (alco_check Alcotest.int64 (trace_true Shrink.int64) "on repeated success") + [ ("int 100", 100L, [50L; 25L; 13L; 7L; 4L; 2L; 1L; 0L]); + ("int 1000", 1000L, [500L; 250L; 125L; 63L; 32L; 16L; 8L; 4L; 2L; 1L; 0L]); + ("int (-26)", -26L, [-13L; -7L; -4L; -2L; -1L; 0L]) ] + + let tests = ("Shrink", Alcotest.[ + test_case "int" `Quick test_int; + test_case "int32" `Quick test_int32; + test_case "int64" `Quick test_int64; + ]) +end + +module Check_exn = struct + + let check_exn = Test.check_exn + + let test_pass_trivial () = + let run_test () = check_exn QCheck.(Test.make int (fun _ -> true)) in + Alcotest.(check unit) "Success-trivial" () @@ run_test () + + let test_pass_random () = + let run_test () = + check_exn QCheck.(Test.make (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 63 shrink steps)" in + let run_test () = + check_exn QCheck.(Test.make ~name 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 126 shrink steps)" in + let run_test () = + check_exn + QCheck.(Test.make ~name (list int) (fun l -> List.rev l = l)) in + Alcotest.check_raises "Fail" (Test.Test_fail (name,[counterex_str])) run_test + + exception MyError + + let test_error () = + let name = "will-always-error" in + let counterex_str = "0 (after 63 shrink steps)" in + let run_test () = + let () = Printexc.record_backtrace false in (* for easier pattern-matching below *) + check_exn QCheck.(Test.make ~name int (fun _ -> raise MyError)) in + Alcotest.check_raises "MyError" (Test.Test_error (name,counterex_str,MyError,"")) 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" + [ + Shrink.tests; + Check_exn.tests; + ] diff --git a/test/core/dune b/test/core/dune index 9d6e6e9f..94523bb9 100644 --- a/test/core/dune +++ b/test/core/dune @@ -1,45 +1,10 @@ - -(test - (name test) - (modules test) - (package qcheck-core) - (libraries qcheck-core alcotest)) - -(executables +(tests (names QCheck_expect_test QCheck2_expect_test) (modules QCheck_expect_test QCheck2_expect_test) (libraries qcheck-core qcheck-core.runner)) -;; rules for QCheck_expect_test -(rule - (targets qcheck_output.txt) - (deps ./QCheck_expect_test.exe) - (package qcheck-core) - (enabled_if (= %{os_type} "Unix")) - (action - (with-stdout-to - %{targets} - (run ./QCheck_expect_test.exe --no-colors)))) - -(rule - (alias runtest) +(tests + (names QCheck_unit_tests QCheck2_unit_tests) + (modules QCheck_unit_tests QCheck2_unit_tests) (package qcheck-core) - (enabled_if (= %{os_type} "Unix")) - (action (diff qcheck_output.txt.expected qcheck_output.txt))) - -;; rules for QCheck2_expect_test -(rule - (targets qcheck2_output.txt) - (deps ./QCheck2_expect_test.exe) - (package qcheck-core) - (enabled_if (= %{os_type} "Unix")) - (action - (with-stdout-to - %{targets} - (run ./QCheck2_expect_test.exe --no-colors)))) - -(rule - (alias runtest) - (package qcheck-core) - (enabled_if (= %{os_type} "Unix")) - (action (diff qcheck2_output.txt.expected qcheck2_output.txt))) + (libraries qcheck-core alcotest))