diff --git a/.ocamlformat-ignore b/.ocamlformat-ignore
new file mode 100644
index 00000000..4bf24019
--- /dev/null
+++ b/.ocamlformat-ignore
@@ -0,0 +1,4 @@
+examples/bad/bad.ml
+examples/lwt/test.ml
+examples/floats.ml
+examples/simple.ml
\ No newline at end of file
diff --git a/README.md b/README.md
index 05dcc808..fc1210e6 100644
--- a/README.md
+++ b/README.md
@@ -42,29 +42,30 @@ module To_test = struct
end
(* The tests *)
-let test_lowercase () =
- Alcotest.(check string) "same string" "hello!" (To_test.lowercase "hELLO!")
-
-let test_capitalize () =
- Alcotest.(check string) "same string" "World." (To_test.capitalize "world.")
-
-let test_str_concat () =
- Alcotest.(check string) "same string" "foobar" (To_test.str_concat ["foo"; "bar"])
-
-let test_list_concat () =
- Alcotest.(check (list int)) "same lists" [1; 2; 3] (To_test.list_concat [1] [2; 3])
-
-(* Run it *)
let () =
- let open Alcotest in
- run "Utils" [
- "string-case", [
- test_case "Lower case" `Quick test_lowercase;
- test_case "Capitalization" `Quick test_capitalize;
- ];
- "string-concat", [ test_case "String mashing" `Quick test_str_concat ];
- "list-concat", [ test_case "List mashing" `Slow test_list_concat ];
- ]
+ Alcotest.suite "Utils" begin fun group ->
+ group "string-case" begin fun case ->
+ case "Lower case" begin fun () ->
+ Alcotest.(check string) "same string" "hello!" (To_test.lowercase "hELLO!")
+ end;
+
+ case "Capitalization" begin fun () ->
+ Alcotest.(check string) "same string" "World." (To_test.capitalize "world.")
+ end;
+ end;
+
+ group "string-concat" begin fun case ->
+ case "String mashing" begin fun () ->
+ Alcotest.(check string) "same string" "foobar" (To_test.str_concat ["foo"; "bar"])
+ end;
+ end;
+
+ group "list-concat" begin fun case ->
+ case ~speed:`Slow "List mashing" begin fun () ->
+ Alcotest.(check (list int)) "same lists" [1; 2; 3] (To_test.list_concat [1] [2; 3])
+ end;
+ end;
+ end
```
The result is a self-contained binary which displays the test
diff --git a/examples/bad/bad.ml b/examples/bad/bad.ml
index 78caf25d..73e5a542 100644
--- a/examples/bad/bad.ml
+++ b/examples/bad/bad.ml
@@ -33,38 +33,32 @@ module To_test = struct
let double_all = List.map (fun a -> a + a)
end
-let test_capitalise () =
- To_test.capitalise "b" |> Alcotest.(check string) "strings" "A"
-
-let test_double_all () =
- To_test.double_all [ 1; 1; 2; 3 ]
- |> Alcotest.(check (list int)) "int lists" [ 1 ]
-
-let suite1 =
- [
- ( "to_test",
- [
- ("capitalise", `Quick, test_capitalise);
- ("double all", `Slow, test_double_all);
- ] );
- ]
-
-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 () =
- try Alcotest.run ~and_exit:false "First suite" suite1
+ try
+ Alcotest.suite ~and_exit:false "First suite" begin fun group ->
+ group "to_test" begin fun case ->
+ case "capitalise" begin fun () ->
+ To_test.capitalise "b" |> Alcotest.(check string) "strings" "A"
+ end;
+
+ case ~speed:`Slow "double all" begin fun () ->
+ To_test.double_all [ 1; 1; 2; 3 ]
+ |> Alcotest.(check (list int)) "int lists" [ 1 ]
+ end;
+ end;
+ end
with Alcotest.Test_error ->
Printf.printf "Forging ahead regardless!\n%!";
- Alcotest.run ~and_exit:false "Second suite" suite2;
+ Alcotest.suite ~and_exit:false "Second suite" begin fun group ->
+ group "Ωèone" begin fun case ->
+ case "Passing test 1" ignore;
+
+ case "Failing test" begin fun () ->
+ Alcotest.fail "This was never going to work..."
+ end;
+
+ case "Passing test 2" ignore;
+ end;
+ end;
Printf.printf "Finally done."
diff --git a/examples/floats.ml b/examples/floats.ml
index adf80d4c..5500dee1 100644
--- a/examples/floats.ml
+++ b/examples/floats.ml
@@ -27,28 +27,31 @@ For more information, please refer to
let e = epsilon_float
-let nan () =
- Alcotest.(check @@ float e) "NaN is NaN" nan nan;
- Alcotest.(check @@ neg @@ float e) "NaN is not number" nan 7.;
- Alcotest.(check @@ neg @@ float e) "number is not NaN" 8. nan
-
-let infinity () =
- Alcotest.(check @@ float e) "+∞ is +∞" infinity infinity;
- Alcotest.(check @@ float e) "-∞ is -∞" neg_infinity neg_infinity;
- Alcotest.(check @@ neg @@ float e) "+∞ is not -∞" infinity neg_infinity;
- Alcotest.(check @@ neg @@ float e) "-∞ is not +∞" neg_infinity infinity;
- Alcotest.(check @@ neg @@ float e) "+∞ is not 3" infinity 3.
-
-let others () =
- Alcotest.(check @@ float e) "0 is 0" 0. 0.;
- Alcotest.(check @@ float e) "0 is epsilon" 0. e;
- Alcotest.(check @@ neg @@ float e) "0 is not 1" 0. 1.;
- Alcotest.(check @@ neg @@ float e) "1 is not 0" 1. 0.;
- Alcotest.(check @@ float e) ".3 is .3" (0.1 +. 0.2) 0.3
-
-let edge_set = [ ("NaN", `Quick, nan); ("∞", `Quick, infinity) ]
-let others_set = [ ("others", `Quick, others) ]
-
let () =
- Alcotest.run "Float tests"
- [ ("Edge cases", edge_set); ("Other floats", others_set) ]
+ Alcotest.suite "Float tests" begin fun group ->
+ group "Edge cases" begin fun case ->
+ case "NaN" begin fun () ->
+ Alcotest.(check @@ float e) "NaN is NaN" nan nan;
+ Alcotest.(check @@ neg @@ float e) "NaN is not number" nan 7.;
+ Alcotest.(check @@ neg @@ float e) "number is not NaN" 8. nan
+ end;
+
+ case "∞" begin fun () ->
+ Alcotest.(check @@ float e) "+∞ is +∞" infinity infinity;
+ Alcotest.(check @@ float e) "-∞ is -∞" neg_infinity neg_infinity;
+ Alcotest.(check @@ neg @@ float e) "+∞ is not -∞" infinity neg_infinity;
+ Alcotest.(check @@ neg @@ float e) "-∞ is not +∞" neg_infinity infinity;
+ Alcotest.(check @@ neg @@ float e) "+∞ is not 3" infinity 3.
+ end;
+ end;
+
+ group "Other floats" begin fun case ->
+ case "others" begin fun () ->
+ Alcotest.(check @@ float e) "0 is 0" 0. 0.;
+ Alcotest.(check @@ float e) "0 is epsilon" 0. e;
+ Alcotest.(check @@ neg @@ float e) "0 is not 1" 0. 1.;
+ Alcotest.(check @@ neg @@ float e) "1 is not 0" 1. 0.;
+ Alcotest.(check @@ float e) ".3 is .3" (0.1 +. 0.2) 0.3
+ end;
+ end;
+ end
diff --git a/examples/lwt/test.ml b/examples/lwt/test.ml
index fe5a4e07..b3d1d3d0 100644
--- a/examples/lwt/test.ml
+++ b/examples/lwt/test.ml
@@ -25,7 +25,7 @@ OTHER DEALINGS IN THE SOFTWARE.
For more information, please refer to
*)
-open Lwt.Infix
+open Lwt.Syntax
exception Library_exception
@@ -34,67 +34,68 @@ module To_test = struct
let lowercase_lwt s = Lwt.return (lowercase s)
let exn () = raise Library_exception
let exn_lwt_toplevel () : unit Lwt.t = raise Library_exception
- let exn_lwt_internal () : unit Lwt.t = Lwt.return (raise Library_exception)
+ let exn_lwt_internal () : unit Lwt.t = Lwt.fail Library_exception
end
-(* The tests *)
-let test_lowercase () =
- Alcotest.(check string) "same string" "hello!" (To_test.lowercase "hELLO!")
-
-let test_lowercase_lwt _ () =
- To_test.lowercase_lwt "hELLO!"
- >|= Alcotest.(check string) "same string" "hello!"
-
-let test_exn () =
- Alcotest.check_raises "custom exception" Library_exception To_test.exn
+(* Helper *)
let lwt_check_raises f =
- Lwt.catch
- (fun () -> f () >|= fun () -> `Ok)
- (function e -> Lwt.return @@ `Error e)
- >|= function
- | `Ok -> Alcotest.fail "No exception was thrown"
- | `Error Library_exception -> Alcotest.(check pass) "Correct exception" () ()
- | `Error _ -> Alcotest.fail "Incorrect exception was thrown"
-
-let test_exn_lwt_toplevel _ () = lwt_check_raises To_test.exn_lwt_toplevel
-let test_exn_lwt_internal _ () = lwt_check_raises To_test.exn_lwt_internal
+ let+ res = Lwt.catch
+ (fun () -> Lwt.map (fun () -> Ok ()) @@ f ())
+ (function e -> Lwt.return @@ Error e)
+ in
+ match res with
+ | Ok () -> Alcotest.fail "No exception was thrown"
+ | Error Library_exception -> Alcotest.(check pass) "Correct exception" () ()
+ | Error _ -> Alcotest.fail "Incorrect exception was thrown"
+
let switch = ref None
-let test_switch_alloc s () =
- Lwt.return_unit >|= fun () ->
- switch := Some s;
- Alcotest.(check bool)
- "Passed switch is initially on" (Lwt_switch.is_on s) true
-
-let test_switch_dealloc _ () =
- Lwt.return_unit >|= fun () ->
- match !switch with
- | None -> Alcotest.fail "No switch left by `test_switch_alloc` test"
- | Some s ->
- Alcotest.(check bool)
- "Switch is disabled after test" (Lwt_switch.is_on s) false
-
-(* Run it *)
+(* The tests *)
+
let () =
- let open Alcotest_lwt in
Lwt_main.run
- @@ run "LwtUtils"
- [
- ( "basic",
- [
- test_case_sync "Plain" `Quick test_lowercase;
- test_case "Lwt" `Quick test_lowercase_lwt;
- ] );
- ( "exceptions",
- [
- test_case_sync "Plain" `Quick test_exn;
- test_case "Lwt toplevel" `Quick test_exn_lwt_toplevel;
- test_case "Lwt internal" `Quick test_exn_lwt_internal;
- ] );
- ( "switches",
- [
- test_case "Allocate resource" `Quick test_switch_alloc;
- test_case "Check resource deallocated" `Quick test_switch_dealloc;
- ] );
- ]
+ @@ Alcotest_lwt.suite "LwtUtils" begin fun group ->
+ group "basic" begin fun case ->
+ case "Plain" begin fun _ () ->
+ Lwt.return (Alcotest.(check string) "same string" "hello!" (To_test.lowercase "hELLO!"))
+ end;
+
+ case "Lwt" begin fun _ () ->
+ To_test.lowercase_lwt "hELLO!"
+ |> Lwt.map (Alcotest.(check string) "same string" "hello!")
+ end;
+ end;
+
+ group "exceptions" begin fun case ->
+ case "Plain" begin fun _ () ->
+ Lwt.return (Alcotest.check_raises "custom exception" Library_exception To_test.exn)
+ end;
+
+ case "Lwt toplevel" begin fun _ () ->
+ lwt_check_raises To_test.exn_lwt_toplevel
+ end;
+
+ case "Lwt internal" begin fun _ () ->
+ lwt_check_raises To_test.exn_lwt_internal
+ end;
+ end;
+
+ group "switches" begin fun case ->
+ case "Allocate resource" begin fun s () ->
+ let+ () = Lwt.return_unit in
+ switch := Some s;
+ Alcotest.(check bool)
+ "Passed switch is initially on" (Lwt_switch.is_on s) true
+ end;
+
+ case "Check resource deallocated" begin fun _ () ->
+ let+ () = Lwt.return_unit in
+ match !switch with
+ | None -> Alcotest.fail "No switch left by `test_switch_alloc` test"
+ | Some s ->
+ Alcotest.(check bool)
+ "Switch is disabled after test" (Lwt_switch.is_on s) false
+ end;
+ end;
+ end
diff --git a/examples/simple.ml b/examples/simple.ml
index 51031fd1..4c988bcb 100644
--- a/examples/simple.ml
+++ b/examples/simple.ml
@@ -34,33 +34,27 @@ module To_test = struct
end
(* The tests *)
-let test_lowercase () =
- Alcotest.(check string) "same string" "hello!" (To_test.lowercase "hELLO!")
-
-let test_capitalize () =
- Alcotest.(check string) "same string" "World." (To_test.capitalize "world.")
-
-let test_str_concat () =
- Alcotest.(check string)
- "same string" "foobar"
- (To_test.str_concat [ "foo"; "bar" ])
-
-let test_list_concat () =
- Alcotest.(check (list int))
- "same lists" [ 1; 2; 3 ]
- (To_test.list_concat [ 1 ] [ 2; 3 ])
-
-(* Run it *)
let () =
- Alcotest.run "Utils"
- [
- ( "string-case",
- [
- Alcotest.test_case "Lower case" `Quick test_lowercase;
- Alcotest.test_case "Capitalization" `Quick test_capitalize;
- ] );
- ( "string-concat",
- [ Alcotest.test_case "String mashing" `Quick test_str_concat ] );
- ( "list-concat",
- [ Alcotest.test_case "List mashing" `Slow test_list_concat ] );
- ]
+ Alcotest.suite "Utils" begin fun group ->
+ group "string-case" begin fun case ->
+ case "Lower case" begin fun () ->
+ Alcotest.(check string) "same string" "hello!" (To_test.lowercase "hELLO!")
+ end;
+
+ case "Capitalization" begin fun () ->
+ Alcotest.(check string) "same string" "World." (To_test.capitalize "world.")
+ end;
+ end;
+
+ group "string-concat" begin fun case ->
+ case "String mashing" begin fun () ->
+ Alcotest.(check string) "same string" "foobar" (To_test.str_concat ["foo"; "bar"])
+ end;
+ end;
+
+ group "list-concat" begin fun case ->
+ case ~speed:`Slow "List mashing" begin fun () ->
+ Alcotest.(check (list int)) "same lists" [1; 2; 3] (To_test.list_concat [1] [2; 3])
+ end;
+ end;
+ end
diff --git a/src/alcotest-engine/cli.ml b/src/alcotest-engine/cli.ml
index a15463f0..ffb8a895 100644
--- a/src/alcotest-engine/cli.ml
+++ b/src/alcotest-engine/cli.ml
@@ -167,6 +167,20 @@ module Make (P : Platform.MAKER) (M : Monad.S) :
let run =
Config.User.kcreate (fun config ?argv name tl ->
run_with_args' config ~argv name (Term.const ()) tl)
+
+ let suite =
+ Config.User.kcreate (fun config ?argv name register ->
+ run_with_args' config ~argv name (Term.const ())
+ (suite_testlist register))
+
+ let suite_with_args' ~argv config name args register =
+ run_with_args' ~argv config name args (suite_testlist register)
+
+ let suite_with_args ?and_exit ?verbose ?compact ?tail_errors ?quick_only
+ ?show_errors ?json ?filter ?log_dir ?bail ?record_backtrace ?ci ?argv =
+ Config.User.kcreate (suite_with_args' ~argv) ?and_exit ?verbose ?compact
+ ?tail_errors ?quick_only ?show_errors ?json ?filter ?log_dir ?bail
+ ?record_backtrace ?ci
end
module V1 = struct
diff --git a/src/alcotest-engine/cli_intf.ml b/src/alcotest-engine/cli_intf.ml
index ad979b88..83aceb6e 100644
--- a/src/alcotest-engine/cli_intf.ml
+++ b/src/alcotest-engine/cli_intf.ml
@@ -52,6 +52,46 @@ module V1_types = struct
[a]. Every test function will receive as argument the evaluation of the
[Cmdliner] term [a]: this is useful to configure the test behaviors
using the CLI. *)
+
+ val suite :
+ (?argv:string array -> string -> (unit group -> unit) -> return)
+ with_options
+ (** [suite n register] runs the test suite registered by the registration
+ function [register]. [n] is the name of the tested library.
+
+ Other parameters are the same as they are in [run].
+
+ Example usage:
+
+ {[
+ let () =
+ Alcotest.suite "Int" begin fun group ->
+ group "( + )" begin fun case ->
+ case "positive + positive" begin fun () ->
+ Alcotest.(check int) "1 + 1" 2 (1 + 1)
+ end;
+
+ case "positive + negative" begin fun () ->
+ Alcotest.(check int) "1 + -1" 0 (1 + -1)
+ end;
+ end;
+
+ group "( - )" begin fun case ->
+ (* Not actually slow, just for demonstration purposes *)
+ case ~speed:`Slow "positive - positive" begin fun () ->
+ Alcotest.(check int) "1 - 1" 0 (1 - 1)
+ end;
+ end;
+ end
+ ]} *)
+
+ val suite_with_args :
+ (?argv:string array ->
+ string ->
+ 'a Cmdliner.Term.t ->
+ ('a group -> unit) ->
+ return)
+ with_options
end
module type MAKER = functor (_ : Platform.MAKER) (M : Monad.S) ->
diff --git a/src/alcotest-engine/core.ml b/src/alcotest-engine/core.ml
index e558fcb4..3681fddd 100644
--- a/src/alcotest-engine/core.ml
+++ b/src/alcotest-engine/core.ml
@@ -64,6 +64,8 @@ module Make (P : Platform.MAKER) (M : Monad.S) = struct
let test_case n s f = (n, s, f)
type 'a test = string * 'a test_case list
+ type 'a case = ?speed:speed_level -> string -> 'a run -> unit
+ type 'a group = string -> ('a case -> unit) -> unit
(* global state *)
type 'a t = {
@@ -417,6 +419,31 @@ module Make (P : Platform.MAKER) (M : Monad.S) = struct
?ci
let run = Config.User.kcreate run'
+
+ let suite_testlist register =
+ let groups = ref [] in
+ let each_group name register =
+ let cases = ref [] in
+ let each_case ?(speed = `Quick) name func =
+ cases := test_case name speed func :: !cases
+ in
+ register each_case;
+ groups := (name, List.rev !cases) :: !groups
+ in
+ register each_group;
+ List.rev !groups
+
+ let suite_with_args' config name args register =
+ run_with_args' config name args (suite_testlist register)
+
+ let suite_with_args ?and_exit ?verbose ?compact ?tail_errors ?quick_only
+ ?show_errors ?json ?filter ?log_dir ?bail ?record_backtrace ?ci =
+ Config.User.kcreate suite_with_args' ?and_exit ?verbose ?compact ?tail_errors
+ ?quick_only ?show_errors ?json ?filter ?log_dir ?bail ?record_backtrace
+ ?ci
+
+ let suite' config name = suite_with_args' config name ()
+ let suite = Config.User.kcreate suite'
end
module V1 = struct
diff --git a/src/alcotest-engine/core_intf.ml b/src/alcotest-engine/core_intf.ml
index fc8b642d..49ca1822 100644
--- a/src/alcotest-engine/core_intf.ml
+++ b/src/alcotest-engine/core_intf.ml
@@ -85,8 +85,14 @@ module V1_types = struct
- [ci] (default auto-detected). Whether to enable specific logging for a
CI system. *)
+ type 'a case = ?speed:speed_level -> string -> ('a -> return) -> unit
+ type 'a group = string -> ('a case -> unit) -> unit
+
val run : (string -> unit test list -> return) with_options
val run_with_args : (string -> 'a -> 'a test list -> return) with_options
+ val suite_testlist : ('a group -> unit) -> 'a test list
+ val suite_with_args : (string -> 'a -> ('a group -> unit) -> return) with_options
+ val suite : (string -> (unit group -> unit) -> return) with_options
end
module type MAKER = functor (_ : Platform.MAKER) (M : Monad.S) -> sig
diff --git a/src/alcotest-lwt/alcotest_lwt.ml b/src/alcotest-lwt/alcotest_lwt.ml
index 886d5c70..90d9b43f 100644
--- a/src/alcotest-lwt/alcotest_lwt.ml
+++ b/src/alcotest-lwt/alcotest_lwt.ml
@@ -27,8 +27,38 @@ module V1 = struct
module Tester = Alcotest_engine.V1.Cli.Make (Alcotest.Unix_platform) (Lwt)
include Tester
+ type 'a case = ?speed:speed_level -> string -> (Lwt_switch.t -> 'a -> unit Lwt.t) -> unit
+ type 'a group = string -> ('a case -> unit) -> unit
+
let test_case_sync n s f = test_case n s (fun x -> Lwt.return (f x))
let test_case n s f = test_case n s (run_test f)
+
+ let suite_testlist register =
+ let groups = ref [] in
+ let each_group name register =
+ let cases = ref [] in
+ let each_case ?(speed = `Quick) name func =
+ cases := test_case name speed func :: !cases
+ in
+ register each_case;
+ groups := (name, List.rev !cases) :: !groups
+ in
+ register each_group;
+ List.rev !groups
+
+ let suite ?and_exit ?verbose ?compact ?tail_errors ?quick_only
+ ?show_errors ?json ?filter ?log_dir ?bail ?record_backtrace ?ci ?argv name
+ register =
+ run ?and_exit ?verbose ?compact ?tail_errors ?quick_only
+ ?show_errors ?json ?filter ?log_dir ?bail ?record_backtrace ?ci ?argv name
+ (suite_testlist register)
+
+ let suite_with_args ?and_exit ?verbose ?compact ?tail_errors ?quick_only
+ ?show_errors ?json ?filter ?log_dir ?bail ?record_backtrace ?ci ?argv name
+ term register =
+ run_with_args ?and_exit ?verbose ?compact ?tail_errors ?quick_only
+ ?show_errors ?json ?filter ?log_dir ?bail ?record_backtrace ?ci ?argv name
+ term (suite_testlist register)
end
include V1
diff --git a/src/alcotest-lwt/alcotest_lwt_intf.ml b/src/alcotest-lwt/alcotest_lwt_intf.ml
index 0743d8ef..364f364a 100644
--- a/src/alcotest-lwt/alcotest_lwt_intf.ml
+++ b/src/alcotest-lwt/alcotest_lwt_intf.ml
@@ -1,6 +1,9 @@
module type V1 = sig
include Alcotest_engine.V1.Cli.S with type return = unit Lwt.t
+ type 'a case = ?speed:speed_level -> string -> (Lwt_switch.t -> 'a -> unit Lwt.t) -> unit
+ type 'a group = string -> ('a case -> unit) -> unit
+
val test_case :
string ->
Alcotest.speed_level ->
@@ -9,6 +12,14 @@ module type V1 = sig
val test_case_sync :
string -> Alcotest.speed_level -> ('a -> unit) -> 'a test_case
+
+ val suite_testlist : ('a group -> unit) -> 'a test list
+
+ val suite :
+ (?argv:string array -> string -> (unit group -> unit) -> unit Lwt.t) with_options
+
+ val suite_with_args :
+ (?argv:string array -> string -> 'a Cmdliner.Term.t -> ('a group -> unit) -> unit Lwt.t) with_options
end
module type Alcotest_lwt = sig
diff --git a/src/alcotest-lwt/dune b/src/alcotest-lwt/dune
index a917a1e3..409b9fcb 100644
--- a/src/alcotest-lwt/dune
+++ b/src/alcotest-lwt/dune
@@ -2,6 +2,7 @@
(name alcotest_lwt)
(public_name alcotest-lwt)
(libraries
+ cmdliner
logs
lwt
fmt