Skip to content

Commit 521e29e

Browse files
craigfecraigfe
committed
Initial implementation of nestable test API
1 parent b8222f6 commit 521e29e

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

74 files changed

+1859
-995
lines changed

Diff for: ‎src/alcotest-async/alcotest_async.ml

+13
Original file line numberDiff line numberDiff line change
@@ -30,3 +30,16 @@ module V1 = struct
3030
end
3131

3232
include V1
33+
34+
module Unstable = struct
35+
module Tester =
36+
Alcotest_engine.Unstable.Cli.Make (Alcotest.Unix_platform) (Promise)
37+
38+
include Tester
39+
40+
let test_sync ?here ?tags ~name fn =
41+
test ?here ?tags ~name (fun x -> Deferred.return (fn x))
42+
43+
let test ?(timeout = sec 2.) ?here ?tags ~name fn =
44+
test ?here ?tags ~name (run_test timeout name fn)
45+
end

Diff for: ‎src/alcotest-async/alcotest_async_intf.ml

+17
Original file line numberDiff line numberDiff line change
@@ -21,4 +21,21 @@ module type Alcotest_async = sig
2121
module V1 : V1
2222
(** An alias of the above API that provides a stability guarantees over major
2323
version changes. *)
24+
25+
module Unstable : sig
26+
open Alcotest_engine.Unstable
27+
28+
include
29+
Cli.S
30+
with type 'a m := 'a Async_kernel.Deferred.t
31+
and type 'a test_args := 'a
32+
and type config := Config.User.t
33+
and type tag_set := Tag.Set.t
34+
35+
val test :
36+
?timeout:Core_kernel.Time.Span.t ->
37+
(('a -> unit Async_kernel.Deferred.t) -> 'a test) Core.identified
38+
39+
val test_sync : (('a -> unit) -> 'a test) Core.identified
40+
end
2441
end

Diff for: ‎src/alcotest-async/dune

+2-1
Original file line numberDiff line numberDiff line change
@@ -2,8 +2,9 @@
22
(name alcotest_async)
33
(public_name alcotest-async)
44
(libraries
5-
alcotest.engine
65
alcotest
6+
alcotest.engine
7+
alcotest.stdlib_ext
78
async_kernel
89
async_unix
910
base

Diff for: ‎src/alcotest-engine/alcotest_engine.ml

+11
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,20 @@
1+
open! Import
2+
13
module V1 = struct
24
module Test = Test
35
module Core = Core.V1
46
module Cli = Cli.V1
57
end
68

9+
module Unstable = struct
10+
module Cli = Cli.Unstable
11+
module Config = Config
12+
module Core = Core.Unstable
13+
module Source_code_position = Source_code_position
14+
module Tag = Tag
15+
module Test = Test
16+
end
17+
718
module Monad = Monad
819
module Platform = Platform
920

Diff for: ‎src/alcotest-engine/alcotest_engine.mli

+13
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,8 @@
2020
to defined tests. The platform-specific runners for these tests are in
2121
[alcotest], [alcotest-lwt], [alcotest-async] and [alcotest-mirage]. *)
2222

23+
open! Import
24+
2325
module V1 : sig
2426
(** Version 1 of the user-facing Alcotest API. *)
2527

@@ -43,6 +45,17 @@ module V1 : sig
4345
(** Wraps {!Core} to provide a command-line interface. *)
4446
end
4547

48+
module Unstable : sig
49+
module Test = Test
50+
(** Unstable version of the user-facing Alcotest API. *)
51+
52+
module Core = Core.Unstable
53+
module Cli = Cli.Unstable
54+
module Tag = Tag
55+
module Config = Config
56+
module Source_code_position = Source_code_position
57+
end
58+
4659
module Monad = Monad
4760
(** Monad signatures for use with {!Core} and {!Cli}. *)
4861

Diff for: ‎src/alcotest-engine/cli.ml

+140-94
Original file line numberDiff line numberDiff line change
@@ -18,113 +18,159 @@
1818
include Cli_intf
1919
open! Import
2020
open Cmdliner
21+
open Cmdliner_syntax
2122

22-
module Make (P : Platform.MAKER) (M : Monad.S) :
23-
V1_types.S with type return = unit M.t = struct
24-
(** *)
25-
26-
(** The priority order for determining options should be as follows:
27-
28-
+ 1. if a CLI flag/option is _explicitly_ set, use that;
29-
+ 2. if the corresponding environment variable is _explicitly_ set, use
30-
that;
31-
+ 3. if the flag/option is set by [run ?argv]
32-
+ 4. if the flag/option is passed to [run] directly, use that;
33-
+ 5. otherwise, use the default behaviour set by {!Alcotest.Core}. *)
23+
let set_color (module Platform : Platform.S) =
24+
let env = Arg.env_var "ALCOTEST_COLOR" in
25+
let+ color_flag =
26+
let enum = [ ("auto", `Auto); ("always", `Ansi_tty); ("never", `None) ] in
27+
let color = Arg.enum enum in
28+
let enum_alts = Arg.doc_alts_enum enum in
29+
let doc =
30+
Fmt.strf
31+
"Colorize the output. $(docv) must be %s. Defaults to %s when running \
32+
inside Dune, otherwise defaults to %s."
33+
enum_alts (Arg.doc_quote "always") (Arg.doc_quote "auto")
34+
in
35+
Arg.(
36+
value & opt (some color) None & info [ "color" ] ~env ~doc ~docv:"WHEN")
37+
in
38+
let style_renderer =
39+
match color_flag with
40+
| Some `Auto -> None
41+
| Some (`Ansi_tty | `None) as a -> a
42+
| None -> (
43+
try
44+
(* Default to [always] when running inside Dune *)
45+
let (_ : string) = Sys.getenv "INSIDE_DUNE" in
46+
Some `Ansi_tty
47+
with Not_found -> None)
48+
in
49+
Platform.setup_std_outputs ?style_renderer ()
3450

35-
module C = Core.V1.Make (P) (M)
36-
include C
51+
module Make (P : Platform.MAKER) (M : Monad.S) = struct
52+
module C = Core.Unstable.Make (P) (M)
3753
module P = P (M)
38-
open Cmdliner_syntax
39-
40-
let set_color =
41-
let env = Arg.env_var "ALCOTEST_COLOR" in
42-
let+ color_flag =
43-
let enum = [ ("auto", `Auto); ("always", `Ansi_tty); ("never", `None) ] in
44-
let color = Arg.enum enum in
45-
let enum_alts = Arg.doc_alts_enum enum in
46-
let doc =
47-
Fmt.strf
48-
"Colorize the output. $(docv) must be %s. Defaults to %s when \
49-
running inside Dune, otherwise defaults to %s."
50-
enum_alts (Arg.doc_quote "always") (Arg.doc_quote "auto")
54+
include C
55+
56+
let run ?here ?(config = Config.User.create ()) ~name suite =
57+
let test_command =
58+
let term =
59+
let+ () = set_color (module P)
60+
and+ cli_config = Config.User.term ~and_exit:false in
61+
let config = Config.User.(cli_config || config) in
62+
run ~name ?here ~config suite
5163
in
52-
Arg.(
53-
value & opt (some color) None & info [ "color" ] ~env ~doc ~docv:"WHEN")
54-
in
55-
let style_renderer =
56-
match color_flag with
57-
| Some `Auto -> None
58-
| Some (`Ansi_tty | `None) as a -> a
59-
| None -> (
60-
try
61-
(* Default to [always] when running inside Dune *)
62-
let (_ : string) = Sys.getenv "INSIDE_DUNE" in
63-
Some `Ansi_tty
64-
with Not_found -> None)
64+
(term, Term.info "test")
6565
in
66-
P.setup_std_outputs ?style_renderer ()
67-
68-
let default_cmd ~and_exit config args library_name tests =
69-
let exec_name = Filename.basename Sys.argv.(0) in
70-
let doc = "Run all the tests." in
71-
let term =
72-
let+ () = set_color
73-
and+ cli_config = Config.User.term ~and_exit
74-
and+ args = args in
75-
let config = Config.User.(cli_config || config) in
76-
run_with_args' config library_name args tests
77-
in
78-
(term, Term.info exec_name ~doc)
79-
80-
let test_cmd config args library_name tests =
81-
let doc = "Run a subset of the tests." in
82-
let term =
83-
let+ () = set_color
84-
and+ cli_config = Config.User.term ~and_exit:true
85-
and+ args = args in
86-
let config = Config.User.(cli_config || config) in
87-
run_with_args' config library_name args tests
88-
in
89-
(term, Term.info "test" ~doc)
90-
91-
let list_cmd tests =
92-
let doc = "List all available tests." in
93-
( (let+ () = set_color in
94-
list_tests tests),
95-
Term.info "list" ~doc )
96-
97-
let run_with_args' (type a) ~argv config name (args : a Term.t)
98-
(tl : a test list) =
99-
let and_exit = Config.User.and_exit config in
100-
let ( >>= ) = M.bind in
101-
let choices = [ list_cmd tl; test_cmd config args name tl ] in
102-
let exit_or_return result =
103-
if and_exit then exit (Term.exit_status_of_result result) else M.return ()
104-
in
105-
let result =
106-
Term.eval_choice ?argv
107-
~catch:and_exit (* Only log exceptions not raised to the user code *)
108-
(default_cmd ~and_exit config args name tl)
109-
choices
66+
let list_command =
67+
let term =
68+
let+ () = set_color (module P) in
69+
list_tests ~name suite
70+
in
71+
(term, Term.info "list")
11072
in
111-
match result with
112-
| `Ok unit_m -> unit_m >>= fun () -> exit_or_return (`Ok ())
73+
let exit_or_return result = exit (Term.exit_status_of_result result) in
74+
match Term.eval_choice test_command [ test_command; list_command ] with
75+
| `Ok f -> M.bind f (fun () -> exit_or_return (`Ok ()))
11376
| (`Help | `Version | `Error `Exn) as result -> exit_or_return result
11477
| `Error (`Parse | `Term) as result ->
11578
exit (Term.exit_status_of_result result)
11679

117-
let run_with_args ?and_exit ?verbose ?compact ?tail_errors ?quick_only
118-
?show_errors ?json ?filter ?log_dir ?bail ?argv =
119-
Config.User.kcreate (run_with_args' ~argv) ?and_exit ?verbose ?compact
120-
?tail_errors ?quick_only ?show_errors ?json ?filter ?log_dir ?bail
121-
122-
let run =
123-
Config.User.kcreate (fun config ?argv name tl ->
124-
run_with_args' config ~argv name (Term.pure ()) tl)
80+
(* TODO *)
12581
end
12682

83+
module Make_v1 : V1_types.MAKER =
84+
functor
85+
(P : Platform.MAKER)
86+
(M : Monad.S)
87+
->
88+
struct
89+
(** *)
90+
91+
(** The priority order for determining options should be as follows:
92+
93+
+ 1. if a CLI flag/option is _explicitly_ set, use that;
94+
+ 2. if the corresponding environment variable is _explicitly_ set, use
95+
that;
96+
+ 3. if the flag/option is set by [run ?argv]
97+
+ 4. if the flag/option is passed to [run] directly, use that;
98+
+ 5. otherwise, use the default behaviour set by {!Alcotest.Core}. *)
99+
100+
module C = Core.V1.Make (P) (M)
101+
include C
102+
module P = P (M)
103+
open Cmdliner_syntax
104+
105+
let default_cmd ~and_exit config args library_name tests =
106+
let exec_name = Filename.basename Sys.argv.(0) in
107+
let doc = "Run all the tests." in
108+
let term =
109+
let+ () = set_color (module P)
110+
and+ cli_config = Config.User.term ~and_exit
111+
and+ args = args in
112+
let config = Config.User.(cli_config || config) in
113+
run_with_args' config library_name args tests
114+
in
115+
(term, Term.info exec_name ~doc)
116+
117+
let test_cmd config args library_name tests =
118+
let doc = "Run a subset of the tests." in
119+
let term =
120+
let+ () = set_color (module P)
121+
and+ cli_config = Config.User.term ~and_exit:true
122+
and+ args = args in
123+
let config = Config.User.(cli_config || config) in
124+
run_with_args' config library_name args tests
125+
in
126+
(term, Term.info "test" ~doc)
127+
128+
let list_cmd suite_name tests =
129+
let doc = "List all available tests." in
130+
( (let+ () = set_color (module P) in
131+
list_tests suite_name tests),
132+
Term.info "list" ~doc )
133+
134+
let run_with_args' (type a) ~argv config name (args : a Term.t)
135+
(tl : a test list) =
136+
let and_exit = Config.User.and_exit config in
137+
let ( >>= ) = M.bind in
138+
let choices = [ list_cmd name tl; test_cmd config args name tl ] in
139+
let exit_or_return result =
140+
if and_exit then exit (Term.exit_status_of_result result)
141+
else M.return ()
142+
in
143+
let result =
144+
Term.eval_choice ?argv
145+
~catch:and_exit (* Only log exceptions not raised to the user code *)
146+
(default_cmd ~and_exit config args name tl)
147+
choices
148+
in
149+
match result with
150+
| `Ok unit_m -> unit_m >>= fun () -> exit_or_return (`Ok ())
151+
| (`Help | `Version | `Error `Exn) as result -> exit_or_return result
152+
| `Error (`Parse | `Term) as result ->
153+
exit (Term.exit_status_of_result result)
154+
155+
let run_with_args ?and_exit ?verbose ?compact ?tail_errors ?quick_only
156+
?show_errors ?json ?filter:_ ?log_dir ?bail ?argv =
157+
Config.User.kcreate (run_with_args' ~argv) ?and_exit ?verbose ?compact
158+
?tail_errors ?quick_only ?show_errors ?json ?filter:None ?log_dir ?bail
159+
160+
let run ?and_exit ?verbose ?compact ?tail_errors ?quick_only ?show_errors
161+
?json ?filter:_ ?log_dir ?bail ?argv name tl =
162+
Config.User.kcreate
163+
(fun c -> run_with_args' ~argv c name (Term.pure ()) tl)
164+
?and_exit ?verbose ?compact ?tail_errors ?quick_only ?show_errors ?json
165+
?filter:None ?log_dir ?bail
166+
end
167+
127168
module V1 = struct
128169
include V1_types
170+
module Make = Make_v1
171+
end
172+
173+
module Unstable = struct
174+
include Unstable_types
129175
module Make = Make
130176
end

Diff for: ‎src/alcotest-engine/cli_intf.ml

+17-2
Original file line numberDiff line numberDiff line change
@@ -58,12 +58,27 @@ module V1_types = struct
5858
S with type return = unit M.t
5959
end
6060

61+
module Unstable_types = struct
62+
module type S = sig
63+
include Core.Unstable.S
64+
(** @inline *)
65+
end
66+
67+
module type MAKER = Core.Unstable.MAKER
68+
end
69+
6170
module type Cli = sig
6271
module V1 : sig
6372
module type S = V1_types.S
6473
module type MAKER = V1_types.MAKER
6574

66-
module Make (P : Platform.MAKER) (M : Monad.S) :
67-
V1_types.S with type return = unit M.t
75+
module Make : MAKER
76+
end
77+
78+
module Unstable : sig
79+
module type S = Unstable_types.S
80+
module type MAKER = Unstable_types.MAKER
81+
82+
module Make : MAKER
6883
end
6984
end

0 commit comments

Comments
 (0)