diff --git a/CHANGES.md b/CHANGES.md index c094983a..3cfd2118 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,8 @@ +### Unreleased + +- Fix a bug in the handling of the `~and_exit:false` option when the test suite + fails. (#271, @CraigFe) + ### 1.2.2 (2020-08-26) - Fail gracefully when the user supplies an empty suite name. (#265, @CraigFe) diff --git a/examples/bad/bad.ml b/examples/bad/bad.ml index bd546690..275b90d4 100644 --- a/examples/bad/bad.ml +++ b/examples/bad/bad.ml @@ -25,38 +25,47 @@ OTHER DEALINGS IN THE SOFTWARE. For more information, please refer to *) -(* Build with - * ocamlbuild -pkg alcotest bad.byte *) +(* Run with [dune exec ./examples/bad/bad.exe] *) (* A module with functions to test *) module To_test = struct - let capit letter = Astring.String.Ascii.uppercase letter + let capitalise = Astring.String.Ascii.uppercase - let plus int_list = List.map (fun a -> a + a) int_list + let double_all = List.map (fun a -> a + a) end -(* The tests *) -let capit () = Alcotest.(check string) "strings" "A" (To_test.capit "b") +let test_capitalise () = + To_test.capitalise "b" |> Alcotest.(check string) "strings" "A" -let plus () = - Alcotest.(check (list int)) "int lists" [ 1 ] (To_test.plus [ 1; 1; 2; 3 ]) +let test_double_all () = + To_test.double_all [ 1; 1; 2; 3 ] + |> Alcotest.(check (list int)) "int lists" [ 1 ] -let test_one = [ ("Capitalize", `Quick, capit); ("Add entries", `Slow, plus) ] - -let test_two = +let suite1 = [ - ("ok", `Quick, fun () -> ()); - ("Capitalize", `Quick, capit); - ("ok", `Quick, fun () -> ()); + ( "to_test", + [ + ("capitalise", `Quick, test_capitalise); + ("double all", `Slow, test_double_all); + ] ); ] -(* Run it *) -let one () = - try Alcotest.run ~and_exit:false "My first test" [ ("Ωèone", test_one) ] - with Alcotest.Test_error -> Printf.printf "Continue!!\n%!" - -let two () = Alcotest.run ~and_exit:true "Hoho" [ ("two", test_two) ] +let suite2 = + [ + ( "Ωèone", + [ + ("Passing test 1", `Quick, fun () -> ()); + ( "Failing test", + `Quick, + fun () -> Alcotest.fail "This was never going to work..." ); + ("Passing test 2", `Quick, fun () -> ()); + ] ); + ] +(* Run both suites completely, even if the first contains failures *) let () = - one (); - two () + try Alcotest.run ~and_exit:false "First suite" suite1 + with Alcotest.Test_error -> + Printf.printf "Forging ahead regardless!\n%!"; + Alcotest.run ~and_exit:false "Second suite" suite2; + Printf.printf "Finally done." diff --git a/src/alcotest-engine/cli.ml b/src/alcotest-engine/cli.ml index eb57397d..a968f9f1 100644 --- a/src/alcotest-engine/cli.ml +++ b/src/alcotest-engine/cli.ml @@ -299,9 +299,9 @@ struct ( Term.(pure (fun () -> list_tests) $ set_color $ pure tests), Term.info "list" ~doc ) - let run_with_args ?and_exit ?verbose ?compact ?tail_errors ?quick_only - ?show_errors ?json ?filter ?log_dir ?argv name (args : 'a Term.t) - (tl : 'a test list) = + let run_with_args ?(and_exit = true) ?verbose ?compact ?tail_errors + ?quick_only ?show_errors ?json ?filter ?log_dir ?argv name + (args : 'a Term.t) (tl : 'a test list) = let ( >>= ) = M.bind in let runtime_flags = { verbose; compact; tail_errors; show_errors; quick_only; json; log_dir } @@ -309,24 +309,23 @@ struct let choices = [ list_cmd tl; - test_cmd ?and_exit runtime_flags ~filter:(`Test_filter filter) args name + test_cmd ~and_exit runtime_flags ~filter:(`Test_filter filter) args name tl; ] in let exit_or_return result = - match and_exit with - | Some true -> exit (Term.exit_status_of_result result) - | _ -> M.return () + if and_exit then exit (Term.exit_status_of_result result) else M.return () in let result = Term.eval_choice ?argv - (default_cmd ?and_exit runtime_flags args name tl) + ~catch:and_exit (* Only log exceptions not raised to the user code *) + (default_cmd ~and_exit runtime_flags args name tl) choices in match result with | `Ok unit_m -> unit_m >>= fun () -> exit_or_return result - | `Help | `Version -> exit_or_return result - | `Error _ -> exit (Term.exit_status_of_result result) + | `Help | `Version | `Error `Exn -> exit_or_return result + | `Error (`Parse | `Term) -> exit (Term.exit_status_of_result result) let run ?and_exit ?verbose ?compact ?tail_errors ?quick_only ?show_errors ?json ?filter ?log_dir ?argv name tl =