Merge pull request #1248 from ocaml/tests-stanza-action

Customize how (test) is run using (action)
ocaml · Sep 10, 2018 · a90c7e8 · a90c7e8
2 parents a858fc1 + b838031
commit a90c7e8
Show file tree

Hide file tree

Showing 21 changed files with 134 additions and 51 deletions.
diff --git a/CHANGES.md b/CHANGES.md
@@ -56,6 +56,9 @@ next
 
 - Make test stanzas honor the -p flag. (#1236, fix #1231, @emillon)
 
+- Test stanzas take an optional (action) field to customize how they run (#1248,
+  #1195, @emillon)
+
 1.1.1 (08/08/2018)
 ------------------
 

diff --git a/doc/dune-files.rst b/doc/dune-files.rst
@@ -743,7 +743,7 @@ to ``expect_test.expected``.
 The optional fields that are supported are a subset of the alias and executables
 fields. In particular, all fields except for ``public_names`` are supported from
 the `executables stanza <shared-exe-fields>`_. Alias fields apart from ``name``
-and ``action`` are allowed.
+are allowed.
 
 test
 ----

diff --git a/src/dune_file.ml b/src/dune_file.ml
@@ -1692,6 +1692,7 @@ module Tests = struct
     ; package    : Package.t option
     ; deps       : Dep_conf.t Bindings.t
     ; enabled_if : String_with_vars.t Blang.t option
+    ; action     : Action.Unexpanded.t option
     }
 
   let gen_parse names =
@@ -1706,6 +1707,7 @@ module Tests = struct
        and deps =
          field "deps" (Bindings.dparse Dep_conf.dparse) ~default:Bindings.empty
        and enabled_if = field_o "enabled_if" Blang.dparse
+       and action = field_o "action" Action.Unexpanded.dparse
        in
        { exes =
            { Executables.
@@ -1719,6 +1721,7 @@ module Tests = struct
        ; package
        ; deps
        ; enabled_if
+       ; action
        })
 
   let multi = gen_parse (field "names" (list (located string)))

diff --git a/src/dune_file.mli b/src/dune_file.mli
@@ -385,6 +385,7 @@ module Tests : sig
     ; package    : Package.t option
     ; deps       : Dep_conf.t Bindings.t
     ; enabled_if : String_with_vars.t Blang.t option
+    ; action     : Action.Unexpanded.t option
     }
 end
 

diff --git a/src/gen_rules.ml b/src/gen_rules.ml
@@ -164,51 +164,46 @@ module Gen(P : Install_rules.Params) = struct
       else
         `Regular
     in
-    let regular_rule run_action alias loc =
-      { alias with Alias_conf.action = Some (loc, run_action) }
-    in
-    let expect_rule run_action (diff : Action.Unexpanded.Diff.t) alias loc =
-      let rule =
-        { Rule.
-          targets = Infer
-        ; deps = Bindings.empty
-        ; action =
-            (loc, Action.Unexpanded.Redirect (Stdout, diff.file2, run_action))
-        ; mode = Standard
-        ; locks = t.locks
-        ; loc
-        } in
-      let alias =
-        { alias with
-          Alias_conf.
-          action = Some (loc, Diff diff)
-        ; locks = t.locks
-        } in
-      (alias, rule)
-    in
     List.iter t.exes.names ~f:(fun (loc, s) ->
+      let test_var_name = "test" in
       let run_action =
-        Action.Unexpanded.Run
-          (String_with_vars.make_text loc ("./" ^ s ^ ".exe"), []) in
-      let base_alias =
-        { Alias_conf.
-          name = "runtest"
-        ; locks = []
-        ; package = t.package
-        ; deps = t.deps
-        ; action = None
-        ; enabled_if = t.enabled_if
-        ; loc
-        } in
+        match t.action with
+        | Some a -> a
+        | None -> Action.Unexpanded.Run (String_with_vars.make_var loc test_var_name, [])
+      in
+      let test_exe = s ^ ".exe" in
+      let test_exe_path = Super_context.Action.map_exe sctx (Path.relative dir test_exe) in
+      let extra_bindings = Pform.Map.singleton test_var_name (Values [Path test_exe_path]) in
+      let add_alias ~loc ~action ~locks =
+        let alias =
+          { Alias_conf.
+            name = "runtest"
+          ; locks
+          ; package = t.package
+          ; deps = t.deps
+          ; action = Some (loc, action)
+          ; enabled_if = t.enabled_if
+          ; loc
+          }
+        in
+        Simple_rules.alias sctx ~extra_bindings ~dir ~scope alias
+      in
       match test_kind (loc, s) with
       | `Regular ->
-        Simple_rules.alias sctx ~dir ~scope
-          (regular_rule run_action base_alias loc)
+          add_alias ~loc ~action:run_action ~locks:[]
       | `Expect diff ->
-        let (alias, rule) =
-          expect_rule run_action diff base_alias loc in
-        Simple_rules.alias sctx alias ~dir ~scope;
-        ignore (Simple_rules.user_rule sctx rule ~dir ~scope : Path.t list));
+        let rule =
+          { Rule.
+            targets = Infer
+          ; deps = Bindings.empty
+          ; action =
+              (loc, Action.Unexpanded.Redirect (Stdout, diff.file2, run_action))
+          ; mode = Standard
+          ; locks = t.locks
+          ; loc
+          } in
+        add_alias ~loc ~action:(Diff diff) ~locks:t.locks;
+        ignore (Simple_rules.user_rule sctx rule ~extra_bindings ~dir ~scope : Path.t list));
     executables_rules t.exes ~dir ~scope ~dir_kind
       ~dir_contents
 

diff --git a/src/simple_rules.ml b/src/simple_rules.ml
@@ -9,12 +9,19 @@ module SC = Super_context
 let interpret_locks sctx ~dir ~scope locks =
   List.map locks ~f:(SC.expand_vars_path sctx ~dir ~scope)
 
-let user_rule sctx ~dir ~scope (rule : Rule.t) =
+let dep_bindings ~extra_bindings deps =
+  let base = Pform.Map.of_bindings deps in
+  match extra_bindings with
+  | Some bindings -> Pform.Map.superpose base bindings
+  | None -> base
+
+let user_rule sctx ?extra_bindings ~dir ~scope (rule : Rule.t) =
   let targets : SC.Action.targets =
     match rule.targets with
     | Infer -> Infer
     | Static fns -> Static (List.map fns ~f:(Path.relative dir))
   in
+  let bindings = dep_bindings ~extra_bindings rule.deps in
   SC.add_rule_get_targets sctx ~mode:rule.mode ~loc:rule.loc
     ~locks:(interpret_locks sctx ~dir ~scope rule.locks)
     (SC.Deps.interpret_named sctx ~scope ~dir rule.deps
@@ -24,7 +31,7 @@ let user_rule sctx ~dir ~scope (rule : Rule.t) =
        (snd rule.action)
        ~loc:(fst rule.action)
        ~dir
-       ~bindings:(Pform.Map.of_bindings rule.deps)
+       ~bindings
        ~dep_kind:Required
        ~targets
        ~targets_dir:dir
@@ -76,7 +83,7 @@ let add_alias sctx ~dir ~name ~stamp ~loc ?(locks=[]) build =
   let alias = Build_system.Alias.make name ~dir in
   SC.add_alias_action sctx alias ~loc ~locks ~stamp build
 
-let alias sctx ~dir ~scope (alias_conf : Alias_conf.t) =
+let alias sctx ?extra_bindings ~dir ~scope (alias_conf : Alias_conf.t) =
   let enabled =
     match alias_conf.enabled_if with
     | None -> true
@@ -110,13 +117,14 @@ let alias sctx ~dir ~scope (alias_conf : Alias_conf.t) =
        match alias_conf.action with
        | None -> Build.progn []
        | Some (loc, action) ->
+         let bindings = dep_bindings ~extra_bindings alias_conf.deps in
          SC.Action.run
            sctx
            action
            ~loc
            ~dir
            ~dep_kind:Required
-           ~bindings:(Pform.Map.of_bindings alias_conf.deps)
+           ~bindings
            ~targets:Alias
            ~targets_dir:dir
            ~scope)

diff --git a/src/simple_rules.mli b/src/simple_rules.mli
@@ -7,6 +7,7 @@ open Dune_file
 (** Interpret a [(rule ...)] stanza and return the targets it produces. *)
 val user_rule
   :  Super_context.t
+  -> ?extra_bindings:Pform.Map.t
   -> dir:Path.t
   -> scope:Scope.t
   -> Rule.t
@@ -24,6 +25,7 @@ val copy_files
 (** Interpret an [(alias ...)] stanza. *)
 val alias
   :  Super_context.t
+  -> ?extra_bindings:Pform.Map.t
   -> dir:Path.t
   -> scope:Scope.t
   -> Alias_conf.t

diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml
@@ -8,15 +8,28 @@ type t =
   ; syntax_version : Syntax.Version.t
   }
 
-let make_text ?(quoted=false) loc s =
+let make ?(quoted=false) loc part =
   { template =
-      { parts = [Text s]
+      { parts = [part]
       ; quoted
       ; loc
       }
   ; syntax_version = (1, 0)
   }
 
+let make_text ?quoted loc s =
+  make ?quoted loc (Text s)
+
+let make_var ?quoted loc name =
+  let var =
+    { loc
+    ; name
+    ; payload = None
+    ; syntax = Percent
+  }
+  in
+  make ?quoted loc (Var var)
+
 let literal ~quoted ~loc s =
   { parts = [Text s]
   ; quoted

diff --git a/src/string_with_vars.mli b/src/string_with_vars.mli
@@ -25,6 +25,7 @@ include Dsexp.Sexpable with type t := t
 val virt       : ?quoted: bool -> (string * int * int * int) -> string -> t
 val virt_var   : ?quoted: bool -> (string * int * int * int) -> string -> t
 val virt_text  : (string * int * int * int) -> string -> t
+val make_var   : ?quoted: bool -> Loc.t -> string -> t
 val make_text  : ?quoted: bool -> Loc.t -> string -> t
 
 val is_var : t -> name:string -> bool

diff --git a/src/super_context.mli b/src/super_context.mli
@@ -234,6 +234,8 @@ module Action : sig
     -> scope:Scope.t
     -> Action.Unexpanded.t
     -> (Path.t Bindings.t, Action.t) Build.t
+
+  val map_exe : t -> Path.t -> Path.t
 end
 
 module Pkg_version : sig

diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc
@@ -796,6 +796,14 @@
    test-cases/tests-stanza
    (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
+(alias
+ (name tests-stanza-action)
+ (deps (package dune) (source_tree test-cases/tests-stanza-action))
+ (action
+  (chdir
+   test-cases/tests-stanza-action
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+
 (alias
  (name too-many-parens)
  (deps (package dune) (source_tree test-cases/too-many-parens))
@@ -958,6 +966,7 @@
   (alias subst)
   (alias syntax-versioning)
   (alias tests-stanza)
+  (alias tests-stanza-action)
   (alias too-many-parens)
   (alias use-meta)
   (alias utop)
@@ -1053,6 +1062,7 @@
   (alias subst)
   (alias syntax-versioning)
   (alias tests-stanza)
+  (alias tests-stanza-action)
   (alias too-many-parens)
   (alias use-meta)
   (alias utop-default)

diff --git a/test/blackbox-tests/test-cases/tests-stanza-action/default/dune b/test/blackbox-tests/test-cases/tests-stanza-action/default/dune
@@ -0,0 +1,3 @@
+(test
+ (name my_test)
+)
diff --git a/test/blackbox-tests/test-cases/tests-stanza-action/default/my_test.ml b/test/blackbox-tests/test-cases/tests-stanza-action/default/my_test.ml
@@ -0,0 +1,4 @@
+let show_argument n argument =
+  Printf.printf "argv[%d] = %S\n" n argument
+
+let () = Array.iteri show_argument Sys.argv
diff --git a/test/blackbox-tests/test-cases/tests-stanza-action/dune-project b/test/blackbox-tests/test-cases/tests-stanza-action/dune-project
@@ -0,0 +1 @@
+(lang dune 1.2)
diff --git a/test/blackbox-tests/test-cases/tests-stanza-action/explicit-expect/dune b/test/blackbox-tests/test-cases/tests-stanza-action/explicit-expect/dune
@@ -0,0 +1,4 @@
+(tests
+ (names my_test)
+ (action (run %{test} arg1 arg2 arg3))
+)
diff --git a/test/blackbox-tests/test-cases/tests-stanza-action/explicit-expect/my_test.expected b/test/blackbox-tests/test-cases/tests-stanza-action/explicit-expect/my_test.expected
@@ -0,0 +1,4 @@
+argv[0] = "./my_test.exe"
+argv[1] = "arg1"
+argv[2] = "arg2"
+argv[3] = "arg3"
diff --git a/test/blackbox-tests/test-cases/tests-stanza-action/explicit-expect/my_test.ml b/test/blackbox-tests/test-cases/tests-stanza-action/explicit-expect/my_test.ml
@@ -0,0 +1,4 @@
+let show_argument n argument =
+  Printf.printf "argv[%d] = %S\n" n argument
+
+let () = Array.iteri show_argument Sys.argv
diff --git a/test/blackbox-tests/test-cases/tests-stanza-action/explicit-regular/dune b/test/blackbox-tests/test-cases/tests-stanza-action/explicit-regular/dune
@@ -0,0 +1,4 @@
+(tests
+ (names my_test)
+ (action (run %{test} arg1 arg2 arg3))
+)
diff --git a/test/blackbox-tests/test-cases/tests-stanza-action/explicit-regular/my_test.ml b/test/blackbox-tests/test-cases/tests-stanza-action/explicit-regular/my_test.ml
@@ -0,0 +1,4 @@
+let show_argument n argument =
+  Printf.printf "argv[%d] = %S\n" n argument
+
+let () = Array.iteri show_argument Sys.argv
diff --git a/test/blackbox-tests/test-cases/tests-stanza-action/run.t b/test/blackbox-tests/test-cases/tests-stanza-action/run.t
@@ -0,0 +1,17 @@
+If there is an (action) field, it is used to invoke to the executable (in both
+regular and expect modes:
+
+  $ dune build @explicit-regular/runtest
+       my_test alias explicit-regular/runtest
+  argv[0] = "./my_test.exe"
+  argv[1] = "arg1"
+  argv[2] = "arg2"
+  argv[3] = "arg3"
+
+  $ dune build @explicit-expect/runtest
+
+If there is no field, the program is run with no arguments:
+
+  $ dune build @default/runtest
+       my_test alias default/runtest
+  argv[0] = "./my_test.exe"
diff --git a/test/blackbox-tests/test-cases/tests-stanza/run.t b/test/blackbox-tests/test-cases/tests-stanza/run.t
@@ -11,15 +11,15 @@
   Entering directory 'plural'
       ocamldep .expect_test.eobjs/expect_test.ml.d
       ocamldep .expect_test.eobjs/regular_test.ml.d
-        ocamlc .expect_test.eobjs/expect_test.{cmi,cmo,cmt}
-      ocamlopt .expect_test.eobjs/expect_test.{cmx,o}
-      ocamlopt expect_test.exe
-   expect_test expect_test.output
         ocamlc .expect_test.eobjs/regular_test.{cmi,cmo,cmt}
       ocamlopt .expect_test.eobjs/regular_test.{cmx,o}
       ocamlopt regular_test.exe
   regular_test alias runtest
   regular test
+        ocamlc .expect_test.eobjs/expect_test.{cmi,cmo,cmt}
+      ocamlopt .expect_test.eobjs/expect_test.{cmx,o}
+      ocamlopt expect_test.exe
+   expect_test expect_test.output
   $ dune runtest --diff-command false --root generated --display short
   Entering directory 'generated'
       ocamldep .generated.eobjs/generated.ml.d