From 813e5d1f9bd86407af0359275128eba4c36ddc29 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Alex=20L=C3=B3pez?= Date: Sat, 11 Feb 2023 08:17:02 +0100 Subject: [PATCH 1/8] Make `Test.check_exn` honor test polarity --- example/alcotest/output.txt.expected.32 | 3 +-- example/alcotest/output.txt.expected.64 | 3 +-- src/alcotest/QCheck_alcotest.ml | 10 +-------- src/core/QCheck2.ml | 17 +++++++++----- src/ounit/QCheck_ounit.ml | 30 +++++++------------------ 5 files changed, 23 insertions(+), 40 deletions(-) diff --git a/example/alcotest/output.txt.expected.32 b/example/alcotest/output.txt.expected.32 index 634312ae..d6f2301e 100644 --- a/example/alcotest/output.txt.expected.32 +++ b/example/alcotest/output.txt.expected.32 @@ -29,8 +29,7 @@ on `0 (after 31 shrink steps)` │ [FAIL] suite 4 neg test unexpected success. │ └──────────────────────────────────────────────────────────────────────────────┘ negative test 'neg test unexpected success' succeeded unexpectedly -ASSERT negative test 'neg test unexpected success' succeeded unexpectedly -FAIL negative test 'neg test unexpected success' succeeded unexpectedly +[exception] negative test `neg test unexpected success` succeeded unexpectedly ────────────────────────────────────────────────────────────────────────────── ┌──────────────────────────────────────────────────────────────────────────────┐ │ [FAIL] suite 5 neg fail with error. │ diff --git a/example/alcotest/output.txt.expected.64 b/example/alcotest/output.txt.expected.64 index ea706c72..5ab8c71a 100644 --- a/example/alcotest/output.txt.expected.64 +++ b/example/alcotest/output.txt.expected.64 @@ -29,8 +29,7 @@ on `0 (after 63 shrink steps)` │ [FAIL] suite 4 neg test unexpected success. │ └──────────────────────────────────────────────────────────────────────────────┘ negative test 'neg test unexpected success' succeeded unexpectedly -ASSERT negative test 'neg test unexpected success' succeeded unexpectedly -FAIL negative test 'neg test unexpected success' succeeded unexpectedly +[exception] negative test `neg test unexpected success` succeeded unexpectedly ────────────────────────────────────────────────────────────────────────────── ┌──────────────────────────────────────────────────────────────────────────────┐ │ [FAIL] suite 5 neg fail with error. │ diff --git a/src/alcotest/QCheck_alcotest.ml b/src/alcotest/QCheck_alcotest.ml index 0baffa40..d2f26152 100644 --- a/src/alcotest/QCheck_alcotest.ml +++ b/src/alcotest/QCheck_alcotest.ml @@ -54,14 +54,6 @@ let to_alcotest let name = T.get_name cell in let run () = let call = Raw.callback ~colors ~verbose ~print_res:true ~print in - if T.get_positive cell - then - T.check_cell_exn ~long ~call ~handler ~rand cell - else - try - T.check_cell_exn ~long ~call ~handler ~rand cell; - Alcotest.failf "negative test '%s' succeeded unexpectedly" name - with - T.Test_fail (_name,_l) -> () + T.check_cell_exn ~long ~call ~handler ~rand cell in ((name, `Slow, run) : unit Alcotest.test_case) diff --git a/src/core/QCheck2.ml b/src/core/QCheck2.ml index 58cb1713..a0cc4e7b 100644 --- a/src/core/QCheck2.ml +++ b/src/core/QCheck2.ml @@ -1406,6 +1406,7 @@ module Test_exceptions = struct exception Test_fail of string * string list exception Test_error of string * string * exn * string + exception Test_unexpected_success of string end module Test = struct @@ -1882,6 +1883,8 @@ module Test = struct let print_test_fail name l = asprintf "@[%a@]@?" (pp_print_test_fail name) l + let print_unexpected_success name = Format.sprintf "@[negative test `%s`@ succeeded unexpectedly@]" name + let print_test_error name i e stack = Format.sprintf "@[test `%s`@ raised exception `%s`@ on `%s`@,%s@]" name (Printexc.to_string e) i stack @@ -1982,6 +1985,7 @@ module Test = struct (function | Test_fail (name,l) -> Some (print_test_fail name l) | Test_error (name,i,e,st) -> Some (print_test_error name i e st) + | Test_unexpected_success name -> Some (print_unexpected_success name) | User_fail s -> Some ("qcheck: user fail:\n" ^ s) | _ -> None) @@ -1998,14 +2002,17 @@ module Test = struct let print_error ?(st="") arb name (i,e) = print_test_error name (print_c_ex arb i) e st - let check_result cell res = match res.R.state with - | R.Success -> () - | R.Error {instance; exn; backtrace} -> + let check_result cell res = match res.R.state, cell.positive with + | R.Success, true -> () + | R.Success, false -> + raise (Test_unexpected_success cell.name) + | R.Error {instance; exn; backtrace}, _ -> raise (Test_error (cell.name, print_c_ex cell instance, exn, backtrace)) - | R.Failed {instances=l} -> + | R.Failed {instances=l}, true -> let l = List.map (print_c_ex cell) l in raise (Test_fail (cell.name, l)) - | R.Failed_other {msg} -> + | R.Failed _, false -> () + | R.Failed_other {msg}, _ -> raise (Test_fail (cell.name, [msg])) let check_cell_exn ?long ?call ?step ?handler ?rand cell = diff --git a/src/ounit/QCheck_ounit.ml b/src/ounit/QCheck_ounit.ml index b6b2e665..eec329d2 100644 --- a/src/ounit/QCheck_ounit.ml +++ b/src/ounit/QCheck_ounit.ml @@ -72,16 +72,8 @@ let to_ounit2_test ?(rand =default_rand()) (QCheck2.Test.Test cell) = fail = (fun fmt -> Printf.ksprintf assert_failure fmt); err = (fun fmt -> logf ctxt `Error fmt); } in - if QCheck2.Test.get_positive cell - then - T.check_cell_exn cell - ~long ~rand ~call:(Raw.callback ~colors:false ~verbose ~print_res:true ~print) - else - try - T.check_cell_exn cell - ~long ~rand ~call:(Raw.callback ~colors:false ~verbose ~print_res:true ~print); - () - with T.Test_fail (_,_) -> ()) + T.check_cell_exn cell + ~long ~rand ~call:(Raw.callback ~colors:false ~verbose ~print_res:true ~print)) let to_ounit2_test_list ?rand lst = List.rev (List.rev_map (to_ounit2_test ?rand) lst) @@ -93,18 +85,12 @@ let to_ounit_test_cell ?(verbose=verbose()) ?(long=long_tests()) let module T = QCheck2.Test in let name = T.get_name cell in let run () = - - let res = - try - T.check_cell_exn cell ~long ~rand - ~call:(Raw.callback ~colors:false ~verbose ~print_res:verbose ~print:Raw.print_std); - true - with T.Test_fail _ -> - false - in - if QCheck2.Test.get_positive cell - then res - else not res + try + T.check_cell_exn cell ~long ~rand + ~call:(Raw.callback ~colors:false ~verbose ~print_res:verbose ~print:Raw.print_std); + true + with T.Test_fail _ -> + false in name >:: (fun () -> assert_bool name (run ())) From 289c2143b5448e8fc53d87005d420186dbe5800f Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Tue, 14 Mar 2023 17:31:27 +0100 Subject: [PATCH 2/8] update expected output for OCaml5 too --- example/alcotest/output.txt.expected.ocaml5 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/example/alcotest/output.txt.expected.ocaml5 b/example/alcotest/output.txt.expected.ocaml5 index 23401ac2..aaf5db1e 100644 --- a/example/alcotest/output.txt.expected.ocaml5 +++ b/example/alcotest/output.txt.expected.ocaml5 @@ -29,8 +29,7 @@ on `0 (after 62 shrink steps)` │ [FAIL] suite 4 neg test unexpected success. │ └──────────────────────────────────────────────────────────────────────────────┘ negative test 'neg test unexpected success' succeeded unexpectedly -ASSERT negative test 'neg test unexpected success' succeeded unexpectedly -FAIL negative test 'neg test unexpected success' succeeded unexpectedly +[exception] negative test `neg test unexpected success` succeeded unexpectedly ────────────────────────────────────────────────────────────────────────────── ┌──────────────────────────────────────────────────────────────────────────────┐ │ [FAIL] suite 5 neg fail with error. │ From 840419897b319d5d062c9573dbb52ebc8386a93b Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Tue, 14 Mar 2023 17:54:58 +0100 Subject: [PATCH 3/8] Document the test polarity behaviour --- src/core/QCheck2.mli | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/src/core/QCheck2.mli b/src/core/QCheck2.mli index e5392b47..6fe9d599 100644 --- a/src/core/QCheck2.mli +++ b/src/core/QCheck2.mli @@ -1801,9 +1801,11 @@ module Test : sig @since 0.6 *) val check_result : 'a cell -> 'a TestResult.t -> unit - (** [check_result cell res] checks that [res] is [Ok _], and returns unit. + (** For a positive test [check_result cell res] checks that [res] is [Ok _], and returns unit. + For a negative test [check_result cell res] checks that [res] is [Failed _], and returns unit. Otherwise, it raises some exception. - @raise Test_fail if [res = Failed _] + @raise Test_fail if the test is positive and [res = Failed _] + @raise Test_unexpected_success if the test is negative and [res = Ok _] @raise Test_error if [res = Error _] *) type res = @@ -1840,6 +1842,10 @@ module Test : sig predicate [law] is called on them and if it returns [false] or raises an exception then we have a counter-example for the [law]. + Note: [check_cell] ignores a test's polarity, acting as + described above regardless of whether the tested cell is a + positive or negative test. + @param long if [true] then multiply the number of instances to generate by the cell's long_factor. @param call function called on each test case, with the result. @@ -1852,13 +1858,19 @@ module Test : sig ?step:'a step -> ?handler:'a handler -> ?rand:Random.State.t -> 'a cell -> unit (** Same as {!check_cell} but calls {!check_result} on the result. - @raise Test_fail if [res = Failed _] + [check_cell test] honors test polarity and thus expects positive tests to succeed + without finding a counterexample and expects negative tests to fail by finding one. + @raise Test_fail if the test is positive and [res = Failed _] + @raise Test_unexpected_success if the test is negative and [res = Ok _] @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_fail if [res = Failed _] + [check_exn test] honors test polarity and thus expects positive tests to succeed + without finding a counterexample and expects negative tests to fail by finding one. + @raise Test_fail if the test is positive and [res = Failed _] + @raise Test_unexpected_success if the test is negative and [res = Ok _] @raise Test_error if [res = Error _] *) end From b05c3545934434e6f18ff10b9730397fed0761f9 Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Tue, 14 Mar 2023 17:58:55 +0100 Subject: [PATCH 4/8] Document the Test_unexpected_success exception --- src/core/QCheck2.mli | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/core/QCheck2.mli b/src/core/QCheck2.mli index 6fe9d599..9f53d76c 100644 --- a/src/core/QCheck2.mli +++ b/src/core/QCheck2.mli @@ -1649,6 +1649,11 @@ module Test_exceptions : sig [Test_error (name, i, e, st)] means [name] failed on [i] with exception [e], and [st] is the stacktrace (if enabled) or an empty string. *) + + exception Test_unexpected_success of string + (** Exception raised when a negative test failed. + [Test_unexpected_success name] means test [name] failed to find an + expected counter example. *) end (** A test is a pair of a generator and a property that all generated values must satisfy. *) From 0af5a6ae773d0b5e3f30ae174253810e2b95c906 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Alex=20L=C3=B3pez?= Date: Sun, 26 Mar 2023 15:40:33 +0200 Subject: [PATCH 5/8] The succeeding value is actually `Success` rather than `Ok` --- src/core/QCheck2.mli | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/QCheck2.mli b/src/core/QCheck2.mli index 9f53d76c..75f68ce8 100644 --- a/src/core/QCheck2.mli +++ b/src/core/QCheck2.mli @@ -1866,7 +1866,7 @@ module Test : sig [check_cell test] honors test polarity and thus expects positive tests to succeed without finding a counterexample and expects negative tests to fail by finding one. @raise Test_fail if the test is positive and [res = Failed _] - @raise Test_unexpected_success if the test is negative and [res = Ok _] + @raise Test_unexpected_success if the test is negative and [res = Success _] @raise Test_error if [res = Error _] *) val check_exn : ?long:bool -> ?rand:Random.State.t -> t -> unit @@ -1875,7 +1875,7 @@ module Test : sig [check_exn test] honors test polarity and thus expects positive tests to succeed without finding a counterexample and expects negative tests to fail by finding one. @raise Test_fail if the test is positive and [res = Failed _] - @raise Test_unexpected_success if the test is negative and [res = Ok _] + @raise Test_unexpected_success if the test is negative and [res = Success _] @raise Test_error if [res = Error _] *) end From 8fa296170276597ce240009e3306c68f4642b158 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Alex=20L=C3=B3pez?= Date: Sun, 26 Mar 2023 15:54:03 +0200 Subject: [PATCH 6/8] Link documentation from QCheck to QCheck2 for check_* functions --- src/core/QCheck.mli | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/core/QCheck.mli b/src/core/QCheck.mli index 7e8d4b46..92d31a3f 100644 --- a/src/core/QCheck.mli +++ b/src/core/QCheck.mli @@ -1137,13 +1137,16 @@ module Test : sig ?long:bool -> ?call:'a callback -> ?step:'a step -> ?handler:'a handler -> ?rand:Random.State.t -> 'a cell -> 'a TestResult.t + (** See {!QCheck2.Test.check_cell}. *) val check_cell_exn : ?long:bool -> ?call:'a callback -> ?step:'a step -> ?handler:'a handler -> ?rand:Random.State.t -> 'a cell -> unit + (** See {!QCheck2.Test.check_cell_exn}. *) val check_exn : ?long:bool -> ?rand:Random.State.t -> t -> unit + (** See {!QCheck2.Test.check_exn}. *) end (** {2 Sub-tests} *) From 374c30a7fd6133dc7f41cc762514e09ad62a7672 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Alex=20L=C3=B3pez?= Date: Sun, 26 Mar 2023 16:07:16 +0200 Subject: [PATCH 7/8] Add tests for new polarity-respecting behavior --- test/core/QCheck2_unit_tests.ml | 16 ++++++++++++++++ test/core/QCheck_unit_tests.ml | 16 ++++++++++++++++ 2 files changed, 32 insertions(+) diff --git a/test/core/QCheck2_unit_tests.ml b/test/core/QCheck2_unit_tests.ml index a982c5f8..999bdc81 100644 --- a/test/core/QCheck2_unit_tests.ml +++ b/test/core/QCheck2_unit_tests.ml @@ -313,6 +313,20 @@ module Check_exn = struct then Alcotest.failf "%s: counter-example prefix. Received \"%s\"" name c_ex_str + let test_negative_trivial () = + let run_test () = check_exn QCheck2.(Test.make_neg Gen.int (fun _ -> false)) in + Alcotest.(check unit) "Success-negative-trivial" () @@ run_test () + + let test_negative_test_unexpected_success () = + let name = "negative-trivial-test" in + let run_test () = check_exn QCheck2.(Test.make_neg ~name Gen.int (fun _ -> true)) in + try + run_test (); + Alcotest.failf "Negative test didn't raise expected exception." + with + Test.Test_unexpected_success n -> + Alcotest.(check string) (Printf.sprintf "%s: name" name) n name + let tests = ("Test.check_exn", Alcotest.[ test_case "check_exn pass trivial" `Quick test_pass_trivial; @@ -320,6 +334,8 @@ module Check_exn = struct 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; + test_case "check_exn negative pass trivial" `Quick test_negative_trivial; + test_case "check_exn Unexpected success" `Quick test_negative_test_unexpected_success; ]) end diff --git a/test/core/QCheck_unit_tests.ml b/test/core/QCheck_unit_tests.ml index b9042025..0d4ee74a 100644 --- a/test/core/QCheck_unit_tests.ml +++ b/test/core/QCheck_unit_tests.ml @@ -151,6 +151,20 @@ module Check_exn = struct then Alcotest.failf "%s: counter-example prefix. Received \"%s\"" name c_ex_str + let test_negative_trivial () = + let run_test () = check_exn QCheck2.(Test.make_neg Gen.int (fun _ -> false)) in + Alcotest.(check unit) "Success-negative-trivial" () @@ run_test () + + let test_negative_test_unexpected_success () = + let name = "negative-trivial-test" in + let run_test () = check_exn QCheck2.(Test.make_neg ~name Gen.int (fun _ -> true)) in + try + run_test (); + Alcotest.failf "Negative test didn't raise expected exception." + with + Test.Test_unexpected_success n -> + Alcotest.(check string) (Printf.sprintf "%s: name" name) n name + let tests = ("Test.check_exn", Alcotest.[ test_case "check_exn pass trivial" `Quick test_pass_trivial; @@ -158,6 +172,8 @@ module Check_exn = struct 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; + test_case "check_exn negative pass trivial" `Quick test_negative_trivial; + test_case "check_exn Unexpected success" `Quick test_negative_test_unexpected_success; ]) end From 4ac10da138d8b293e9cb7b336b32cbb14be75608 Mon Sep 17 00:00:00 2001 From: Jan Midtgaard Date: Tue, 2 May 2023 12:33:11 +0200 Subject: [PATCH 8/8] Add a CHANGELOG entry --- CHANGELOG.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 04faafd6..ebe3bc95 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,10 @@ ## NEXT RELEASE +- make `Test.check_result`, `Test.check_cell_exn`, and + `Test.check_exn` honor test polarity by raising + `Test_unexpected_success` when a negative test (expected to have a + counter example), unexpectedly succeeds. - ... ## 0.20