Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 4 additions & 0 deletions .ocamlformat-ignore
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
examples/bad/bad.ml
examples/lwt/test.ml
examples/floats.ml
examples/simple.ml
45 changes: 23 additions & 22 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
54 changes: 24 additions & 30 deletions examples/bad/bad.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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."
51 changes: 27 additions & 24 deletions examples/floats.ml
Original file line number Diff line number Diff line change
Expand Up @@ -27,28 +27,31 @@ For more information, please refer to <http://unlicense.org/>

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
115 changes: 58 additions & 57 deletions examples/lwt/test.ml
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,7 @@ OTHER DEALINGS IN THE SOFTWARE.
For more information, please refer to <http://unlicense.org/>
*)

open Lwt.Infix
open Lwt.Syntax

exception Library_exception

Expand All @@ -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
52 changes: 23 additions & 29 deletions examples/simple.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
14 changes: 14 additions & 0 deletions src/alcotest-engine/cli.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Loading