Merge pull request #8 from mbarbin/expect-tests

Add expect tests

lib/cmdlang_to_climate/src/translate.ml

@@ -139,3 +139,7 @@ module To_ast = Cmdlang.Command.Private.To_ast
 let _param p = p |> To_ast.param |> Param.project
 let _arg a = a |> To_ast.arg |> Arg.project
 let command a = a |> To_ast.command |> Command.to_command
+
+module Private = struct
+  module Arg = Arg
+end

lib/cmdlang_to_climate/src/translate.mli

@@ -1 +1,10 @@
 val command : 'a Cmdlang.Command.t -> 'a Climate.Command.t
+
+module Private : sig
+  (** This module is exported for testing purposes only. Its signature may
+      change in breaking ways without any notice. Do not use. *)
+
+  module Arg : sig
+    val project : 'a Cmdlang_ast.Ast.Arg.t -> 'a Climate.Arg_parser.t
+  end
+end

lib/cmdlang_to_cmdliner/src/translate.mli

@@ -7,6 +7,7 @@ module Private : sig
   module Arg : sig
     val with_dot_suffix : doc:string -> string
     val doc_of_param : doc:string -> param:'a Ast.Param.t -> string
+    val project : 'a Ast.Arg.t -> 'a Cmdliner.Term.t
   end
 
   module Command : sig

test/expect/README.md

@@ -0,0 +1,11 @@
+# Cmdlang expect tests
+
+## Translation
+
+In this directory we aim at having comprehensive coverage for the translation of cmdlang specifications to the supported backends.
+
+We also aim at fully characterizing the behavior of the parsers that are obtained that way. We try to do a good job at capturing in the tests the subtle semantic differences that may be encountered depending on the backend chosen.
+
+### Status?
+
+We're currently increasing coverage as we go. We plan on reaching 100% coverage at the end of this process. Stay tune for progress on this front!

test/expect/arg_test.ml

@@ -0,0 +1,106 @@
+module Core_command = Command
+module Command = Cmdlang.Command
+
+type 'a t =
+  { arg : 'a Command.Arg.t
+  ; base : ('a Core_command.Param.t, Exn.t) Result.t
+  ; climate : ('a Climate.Arg_parser.t, Exn.t) Result.t
+  ; cmdliner : ('a Cmdliner.Term.t, Exn.t) Result.t
+  }
+
+let create arg =
+  let ast_arg = Command.Private.To_ast.arg arg in
+  let base =
+    let config = Cmdlang_to_base.Translate.Config.create () in
+    match Cmdlang_to_base.Translate.Private.Arg.project ast_arg ~config with
+    | { param } -> Ok param
+    | exception e -> Error e
+  in
+  let climate =
+    match Cmdlang_to_climate.Translate.Private.Arg.project ast_arg with
+    | arg_parser -> Ok arg_parser
+    | exception e -> Error e
+  in
+  let cmdliner =
+    match Cmdlang_to_cmdliner.Translate.Private.Arg.project ast_arg with
+    | term -> Ok term
+    | exception e -> Error e
+  in
+  { arg; base; climate; cmdliner }
+;;
+
+module Backend = struct
+  type t =
+    | Climate
+    | Cmdliner
+    | Core_command
+  [@@deriving enumerate, sexp_of]
+
+  let to_string t = Sexp.to_string (sexp_of_t t)
+end
+
+module Command_line = struct
+  type t =
+    { prog : string
+    ; args : string list
+    }
+end
+
+(* Improve the display of certain exceptions encountered during our tests. *)
+let () =
+  Sexplib0.Sexp_conv.Exn_converter.add
+    [%extension_constructor Climate.Parse_error.E]
+    (function
+    | Climate.Parse_error.E e ->
+      List [ Atom "Climate.Parse_error.E"; Atom (Climate.Parse_error.to_string e) ]
+    | _ -> assert false);
+  Sexplib0.Sexp_conv.Exn_converter.add
+    [%extension_constructor Climate.Spec_error.E]
+    (function
+    | Climate.Spec_error.E e ->
+      List [ Atom "Climate.Spec_error.E"; Atom (Climate.Spec_error.to_string e) ]
+    | _ -> assert false);
+  ()
+;;
+
+let eval_base t { Command_line.prog = _; args } =
+  match t.base with
+  | Error e -> print_s [%sexp "Translation Raised", (e : Exn.t)]
+  | Ok param ->
+    (match Core_command.Param.parse param args with
+     | Ok () -> ()
+     | Error e -> print_s [%sexp "Evaluation Failed", (e : Error.t)]
+     | exception e -> print_s [%sexp "Evaluation Raised", (e : Exn.t)])
+;;
+
+let eval_climate t { Command_line.prog; args } =
+  match t.climate with
+  | Error e -> print_s [%sexp "Translation Raised", (e : Exn.t)]
+  | Ok arg_parser ->
+    let cmd = Climate.Command.singleton arg_parser in
+    (match Climate.Command.eval cmd { program = prog; args } with
+     | () -> ()
+     | exception e -> print_s [%sexp "Evaluation Raised", (e : Exn.t)])
+;;
+
+let eval_cmdliner t { Command_line.prog; args } =
+  match t.cmdliner with
+  | Error e -> print_s [%sexp "Translation Raised", (e : Exn.t)]
+  | Ok term ->
+    let cmd = Cmdliner.Cmd.v (Cmdliner.Cmd.info prog) term in
+    (match Cmdliner.Cmd.eval cmd ~argv:(Array.of_list (prog :: args)) with
+     | 0 -> ()
+     | exit_code -> print_s [%sexp "Evaluation Failed", { exit_code : int }]
+     | exception e -> print_s [%sexp "Evaluation Raised", (e : Exn.t)])
+;;
+
+let eval_all t command_line =
+  List.iter Backend.all ~f:(fun backend ->
+    print_endline
+      (Printf.sprintf "----------------------------- %s" (Backend.to_string backend));
+    match backend with
+    | Climate -> eval_climate t command_line
+    | Cmdliner -> eval_cmdliner t command_line
+    | Core_command -> eval_base t command_line);
+  ()
+;;

test/expect/arg_test.mli

@@ -0,0 +1,19 @@
+(** This module allows to stage the translation of a cmdlang argument into
+    different backends for testing. *)
+
+type 'a t
+
+val create : 'a Cmdlang.Command.Arg.t -> 'a t
+
+(** {1 Evaluation} *)
+
+module Command_line : sig
+  type t =
+    { prog : string
+    ; args : string list
+    }
+end
+
+(** Evaluate all backends and print a full trace on standard channel. This is
+    designed with expect_test in mind. *)
+val eval_all : unit t -> Command_line.t -> unit

test/expect/dune

@@ -0,0 +1,42 @@
+(library
+ (name cmdlang_expect_tests)
+ (public_name cmdlang-tests.expect-tests)
+ (inline_tests)
+ (flags
+  :standard
+  -w
+  +a-4-40-41-42-44-45-48-66-32-60-69
+  -warn-error
+  +a
+  -open
+  Base
+  -open
+  Expect_test_helpers_base)
+ (libraries
+  base
+  core.command
+  climate
+  cmdlang
+  cmdlang-to-base
+  cmdlang-to-climate
+  cmdlang-to-cmdliner
+  cmdliner
+  err
+  err-cli
+  expect_test_helpers_core.expect_test_helpers_base
+  loc)
+ (instrumentation
+  (backend bisect_ppx))
+ (lint
+  (pps ppx_js_style -allow-let-operators -check-doc-comments))
+ (preprocess
+  (pps
+   -unused-code-warnings=force
+   ppx_compare
+   ppx_enumerate
+   ppx_expect
+   ppx_hash
+   ppx_here
+   ppx_let
+   ppx_sexp_conv
+   ppx_sexp_value)))

test/expect/test__const.ml

@@ -0,0 +1,20 @@
+module Command = Cmdlang.Command
+
+let%expect_test "const" =
+  let test =
+    Arg_test.create
+      (let%map_open.Command string = Arg.return "hello" in
+       print_endline string)
+  in
+  Arg_test.eval_all test { prog = "test"; args = [] };
+  [%expect
+    {|
+    ----------------------------- Climate
+    hello
+    ----------------------------- Cmdliner
+    hello
+    ----------------------------- Core_command
+    hello
+    |}];
+  ()
+;;