Merge pull request #419 from psafont/exnpect

[Breaking] Change match_raises to be more intuitive

Author: samoht

CHANGES.md

@@ -1,6 +1,9 @@
 ### unreleased
 
 - Add `seq`, a testable for `Seq.t` and `contramap` (#412 @xvw)
+- BREAKING: `match_raises` now expects the user-defined function to return
+  true for expected exceptions. Previously false was interpreted as an
+  expected exception. (#418, #419, @psafont)
 
 ### 1.8.0 (2024-07-25)
 

src/alcotest-engine/test.ml

@@ -263,7 +263,7 @@ let match_raises ?here ?pos msg exnp f =
           Fmt.pf ppf "%t%a %s: got nothing." (pp_location ?here ?pos) Pp.tag
             `Fail msg)
   | Some e ->
-      if exnp e then
+      if not (exnp e) then
         check_err (fun ppf () ->
             Fmt.pf ppf "%t%a %s: got %a." (pp_location ?here ?pos) Pp.tag `Fail
               msg Fmt.exn e)

src/alcotest-engine/test.mli

@@ -158,7 +158,9 @@ val check_raises : (string -> exn -> (unit -> unit) -> unit) extra_info
 
 val match_raises :
   (string -> (exn -> bool) -> (unit -> unit) -> unit) extra_info
-(** Check that an exception is raised. *)
+(** [match_raises msg exception_is_expected f] Runs [f ()], and passes the
+    raised exception to [exception_is_expected]. The check fails when no
+    exception is raised, or [exception_is_expected] returns false. *)
 
 val skip : unit -> 'a
 (** Skip the current test case.

test/e2e/alcotest/passing/dune.inc

@@ -15,6 +15,7 @@
    isatty
    json_output
    list_tests
+   match_raises
    only_monadic_effects
    quick_only
    quick_only_regex
@@ -41,6 +42,7 @@
    isatty
    json_output
    list_tests
+   match_raises
    only_monadic_effects
    quick_only
    quick_only_regex
@@ -621,6 +623,44 @@
  (action
    (diff list_tests-js.expected list_tests-js.processed)))
 
+(rule
+ (target match_raises.actual)
+ (action
+  (with-outputs-to %{target}
+   (with-accepted-exit-codes (or 0 124 125)
+    (run %{dep:match_raises.exe})))))
+
+(rule
+ (target match_raises.processed)
+ (action
+  (with-outputs-to %{target}
+   (run ../../strip_randomness.exe %{dep:match_raises.actual}))))
+
+(rule
+ (alias runtest)
+ (package alcotest)
+ (action
+   (diff match_raises.expected match_raises.processed)))
+
+(rule
+ (target match_raises-js.actual)
+ (action
+  (with-outputs-to %{target}
+   (with-accepted-exit-codes (or 0 124 125)
+    (run node %{dep:match_raises.bc.js})))))
+
+(rule
+ (target match_raises-js.processed)
+ (action
+  (with-outputs-to %{target}
+   (run ../../strip_randomness.exe %{dep:match_raises-js.actual}))))
+
+(rule
+ (alias runtest-js)
+ (package alcotest)
+ (action
+   (diff match_raises-js.expected match_raises-js.processed)))
+
 (rule
  (target only_monadic_effects.actual)
  (action

test/e2e/alcotest/passing/match_raises-js.expected

@@ -0,0 +1,7 @@
+Testing `Exceptions'.
+This run has ID `<uuid>'.
+
+  [OK]          matches_raises          0   True means the exception is expec...
+
+Full test results in `<build-context>/_build/_tests/<test-dir>'.
+Test Successful in <test-duration>s. 1 test run.

test/e2e/alcotest/passing/match_raises.expected

@@ -0,0 +1,7 @@
+Testing `Exceptions'.
+This run has ID `<uuid>'.
+
+  [OK]          matches_raises          0   True means the exception is expec...
+
+Full test results in `<build-context>/_build/_tests/<test-dir>'.
+Test Successful in <test-duration>s. 1 test run.

test/e2e/alcotest/passing/match_raises.ml

@@ -0,0 +1,12 @@
+let to_test () = raise (Failure "")
+let expect_failure = function Failure _ -> true | _ -> false
+let test () = Alcotest.match_raises "Generates Failure" expect_failure to_test
+
+let () =
+  Alcotest.run "Exceptions"
+    [
+      ( "matches_raises",
+        [
+          Alcotest.test_case "True means the exception is expected" `Quick test;
+        ] );
+    ]