diff --git a/CHANGES.md b/CHANGES.md index 1dda534b6f8..dd28336b1bf 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -104,6 +104,10 @@ - Do not warn about merlin files pre 1.9. This warning can only be disabled in 1.9 (#2421, fixes #2399, @emillon) +- Add a new `inline_tests` field in the env stanza to control inline_tests + framework with a variable (#2313, @mlasson, original idea by @diml, review + by @rgrinberg). + 1.10.0 (04/06/2019) ------------------- diff --git a/doc/dune-files.rst b/doc/dune-files.rst index 4a4be480b02..b416eb5b11d 100644 --- a/doc/dune-files.rst +++ b/doc/dune-files.rst @@ -814,6 +814,12 @@ Fields supported in ```` are: be inferred from the basename of ```` by dropping the ``.exe`` suffix if it exists. +- ``(inline_tests )`` where state is either ``enabled``, ``disabled`` or + ``ignored``. This field is available since Dune 1.11. It controls the value + of the variable ``%{inline_tests}`` that is read by the inline test framework. + The default value is ``disabled`` for the ``release`` profile and ``enabled`` + otherwise. + .. _dune-subdirs: dirs (since 1.6) diff --git a/src/dune_env.ml b/src/dune_env.ml index 705a4bad453..6dcc8df4e21 100644 --- a/src/dune_env.ml +++ b/src/dune_env.ml @@ -14,11 +14,31 @@ module Stanza = struct in C.Kind.Dict.make ~c ~cxx + module Inline_tests = struct + type t = + | Enabled + | Disabled + | Ignored + + let decode = + enum + [ "enabled", Enabled + ; "disabled", Disabled + ; "ignored", Ignored ] + + let to_string = function + | Enabled -> "enabled" + | Disabled -> "disabled" + | Ignored -> "ignored" + + end + type config = { flags : Ocaml_flags.Spec.t ; c_flags : Ordered_set_lang.Unexpanded.t C.Kind.Dict.t ; env_vars : Env.t ; binaries : File_binding.Unexpanded.t list + ; inline_tests : Inline_tests.t option } type pattern = @@ -30,6 +50,12 @@ module Stanza = struct ; rules : (pattern * config) list } + let inline_tests_field = + field_o + "inline_tests" + (Syntax.since Stanza.syntax (1, 11) >>> + Inline_tests.decode) + let env_vars_field = field "env-vars" @@ -49,11 +75,13 @@ module Stanza = struct and+ binaries = field ~default:[] "binaries" (Syntax.since Stanza.syntax (1, 6) >>> File_binding.Unexpanded.L.decode) + and+ inline_tests = inline_tests_field in { flags ; c_flags ; env_vars ; binaries + ; inline_tests } let rule = diff --git a/src/dune_env.mli b/src/dune_env.mli index 558d7ff3e6d..5a33aeef173 100644 --- a/src/dune_env.mli +++ b/src/dune_env.mli @@ -3,11 +3,22 @@ open! Stdune type stanza = Stanza.t = .. module Stanza : sig + + module Inline_tests: sig + type t = + | Enabled + | Disabled + | Ignored + val decode: t Dune_lang.Decoder.t + val to_string: t -> string + end + type config = { flags : Ocaml_flags.Spec.t ; c_flags : Ordered_set_lang.Unexpanded.t C.Kind.Dict.t ; env_vars : Env.t ; binaries : File_binding.Unexpanded.t list + ; inline_tests : Inline_tests.t option } type pattern = diff --git a/src/env_node.ml b/src/env_node.ml index dafb3236769..ca455e28d84 100644 --- a/src/env_node.ml +++ b/src/env_node.ml @@ -9,7 +9,8 @@ type t = ; mutable ocaml_flags : Ocaml_flags.t option ; mutable c_flags : (unit, string list) Build.t C.Kind.Dict.t option ; mutable external_ : Env.t option - ; mutable bin_artifacts : Artifacts.Bin.t option + ; mutable bin_artifacts : Artifacts.Bin.t option + ; mutable inline_tests : Dune_env.Stanza.Inline_tests.t option; } let scope t = t.scope @@ -24,6 +25,7 @@ let make ~dir ~inherit_from ~scope ~config = ; external_ = None ; bin_artifacts = None ; local_binaries = None + ; inline_tests = None } let find_config t ~profile = @@ -123,6 +125,26 @@ let rec ocaml_flags t ~profile ~expander = t.ocaml_flags <- Some flags; flags +let rec inline_tests t ~profile = + match t.inline_tests with + | Some x -> x + | None -> + let state : Dune_env.Stanza.Inline_tests.t = + match find_config t ~profile with + | None | Some {inline_tests = None; _} -> + begin match t.inherit_from with + | None -> + if profile = "release" then + Disabled + else + Enabled + | Some (lazy t) -> inline_tests t ~profile + end + | Some {inline_tests = Some s; _} -> s + in + t.inline_tests <- Some state; + state + let rec c_flags t ~profile ~expander ~default_context_flags = match t.c_flags with | Some x -> x diff --git a/src/env_node.mli b/src/env_node.mli index 9da9d480f2d..e8c1eb98afd 100644 --- a/src/env_node.mli +++ b/src/env_node.mli @@ -18,6 +18,8 @@ val external_ : t -> profile:string -> default:Env.t -> Env.t val ocaml_flags : t -> profile:string -> expander:Expander.t -> Ocaml_flags.t +val inline_tests : t -> profile:string -> Dune_env.Stanza.Inline_tests.t + val c_flags : t -> profile:string diff --git a/src/super_context.ml b/src/super_context.ml index 4bbe7200311..02a3da42336 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -153,6 +153,10 @@ end = struct in Env_node.local_binaries node ~profile:t.profile ~expander + let inline_tests ({profile; _} as t) ~dir = + let node = get t ~dir in + Env_node.inline_tests node ~profile + let bin_artifacts t ~dir = let expander = expander_for_artifacts t ~context_expander:t.expander ~dir @@ -177,7 +181,16 @@ end = struct expander_for_artifacts t ~context_expander:t.expander ~dir in let bin_artifacts_host = bin_artifacts_host t ~dir in - Expander.set_bin_artifacts expander ~bin_artifacts_host + let bindings = + let str = + inline_tests t ~dir + |> Dune_env.Stanza.Inline_tests.to_string + in + Pform.Map.singleton "inline_tests" (Values [String str]) + in + expander + |> Expander.add_bindings ~bindings + |> Expander.set_bin_artifacts ~bin_artifacts_host let ocaml_flags t ~dir = Env_node.ocaml_flags (get t ~dir) diff --git a/test/blackbox-tests/test-cases/inline_tests/dune-project b/test/blackbox-tests/test-cases/inline_tests/dune-project index de4fc209200..0636ab6acf4 100644 --- a/test/blackbox-tests/test-cases/inline_tests/dune-project +++ b/test/blackbox-tests/test-cases/inline_tests/dune-project @@ -1 +1 @@ -(lang dune 1.0) +(lang dune 1.11) diff --git a/test/blackbox-tests/test-cases/inline_tests/run.t b/test/blackbox-tests/test-cases/inline_tests/run.t index 8ce063764d3..79b1be5f41d 100644 --- a/test/blackbox-tests/test-cases/inline_tests/run.t +++ b/test/blackbox-tests/test-cases/inline_tests/run.t @@ -1,7 +1,20 @@ $ env -u OCAMLRUNPARAM dune runtest simple run alias simple/runtest (exit 2) (cd _build/default/simple && .foo_simple.inline-tests/run.exe) - Fatal error: exception File "simple/.foo_simple.inline-tests/run.ml-gen", line 1, characters 10-16: Assertion failed + Fatal error: exception File "simple/.foo_simple.inline-tests/run.ml-gen", line 1, characters 40-46: Assertion failed + [1] + +The expected behavior for the following three tests is to output nothing: the tests are disabled or ignored. + $ env -u OCAMLRUNPARAM dune runtest simple --profile release + + $ env -u OCAMLRUNPARAM dune runtest simple --profile disable-inline-tests + + $ env -u OCAMLRUNPARAM dune runtest simple --profile ignore-inline-tests + + $ env -u OCAMLRUNPARAM dune runtest simple --profile enable-inline-tests + run alias simple/runtest (exit 2) + (cd _build/default/simple && .foo_simple.inline-tests/run.exe) + Fatal error: exception File "simple/.foo_simple.inline-tests/run.ml-gen", line 1, characters 40-46: Assertion failed [1] $ dune runtest missing-backend diff --git a/test/blackbox-tests/test-cases/inline_tests/simple/dune b/test/blackbox-tests/test-cases/inline_tests/simple/dune index 8e2f4f99236..e823a7f85b6 100644 --- a/test/blackbox-tests/test-cases/inline_tests/simple/dune +++ b/test/blackbox-tests/test-cases/inline_tests/simple/dune @@ -2,9 +2,13 @@ (name backend_simple) (modules ()) (inline_tests.backend - (generate_runner (run sed "s/(\\*TEST:\\(.*\\)\\*)/let () = \\1;;/" %{impl-files}) + (generate_runner (run sed "s/(\\*TEST:\\(.*\\)\\*)/let () = if \"%{inline_tests}\" = \"enabled\" then \\1;;/" %{impl-files}) ))) (library (name foo_simple) (inline_tests (backend backend_simple))) + +(env (ignore-inline-tests (inline_tests ignored)) + (enable-inline-tests (inline_tests enabled)) + (disable-inline-tests (inline_tests disabled)))