diff --git a/CHANGES.md b/CHANGES.md index f78ef851c24..8f79831857b 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -13,6 +13,9 @@ Unreleased - Fix bootstrap script with custom configuration. (#3757, fixes #3774, @marsam) +- Add the `executable` field to `inline_tests` to customize the compilation + flags of the test runner executable (#3747, fixes #3679, @lubegasimon) + 2.7.1 (2/09/2020) ----------------- diff --git a/doc/tests.rst b/doc/tests.rst index 7ec611f0145..c2b95bf26c6 100644 --- a/doc/tests.rst +++ b/doc/tests.rst @@ -33,8 +33,8 @@ with other targets by passing ``@runtest`` to ``dune build``. For instance: .. code:: bash - $ dune build @install @runtest - $ dune build @install @test/runtest + $ dune build @install @runtest + $ dune build @install @test/runtest Running a single test @@ -71,39 +71,39 @@ follows: .. code:: ocaml - let rec fact n = if n = 1 then 1 else n * fact (n - 1) + let rec fact n = if n = 1 then 1 else n * fact (n - 1) - let%test _ = fact 5 = 120 + let%test _ = fact 5 = 120 The file has to be preprocessed with the ppx_inline_test ppx rewriter, so for instance the ``dune`` file might look like this: .. code:: scheme - (library - (name foo) - (preprocess (pps ppx_inline_test))) + (library + (name foo) + (preprocess (pps ppx_inline_test))) In order to instruct dune that our library contains inline tests, all we have to do is add an ``inline_tests`` field: .. code:: scheme - (library - (name foo) - (inline_tests) - (preprocess (pps ppx_inline_test))) + (library + (name foo) + (inline_tests) + (preprocess (pps ppx_inline_test))) We can now build and execute this test by running ``dune runtest``. For instance, if we make the test fail by replacing ``120`` by ``0`` we get: .. code:: bash - $ dune runtest - [...] - File "src/fact.ml", line 3, characters 0-25: <<(fact 5) = 0>> is false. + $ dune runtest + [...] + File "src/fact.ml", line 3, characters 0-25: <<(fact 5) = 0>> is false. - FAILED 1 / 1 tests + FAILED 1 / 1 tests Note that in this case Dune knew how to build and run the tests without any special configuration. This is because ppx_inline_test @@ -115,9 +115,9 @@ field: .. code:: scheme - (library - (name foo) - (inline_tests (backend qtest.lib))) + (library + (name foo) + (inline_tests (backend qtest.lib))) In the example above, the name `qtest.lib` comes from the `public_name` field in `qtest`'s own `dune` file. @@ -132,11 +132,11 @@ expect this code to print. For instance, using ppx_expect_: .. code:: ocaml - let%expect_test _ = - print_endline "Hello, world!"; - [%expect{| - Hello, world! - |}] + let%expect_test _ = + print_endline "Hello, world!"; + [%expect{| + Hello, world! + |}] The test procedure consist of executing the OCaml code and replacing the contents of the ``[%expect]`` extension point by the real @@ -163,10 +163,10 @@ your list of ppx rewriters as follows: .. code:: scheme - (library - (name foo) - (inline_tests) - (preprocess (pps ppx_expect))) + (library + (name foo) + (inline_tests) + (preprocess (pps ppx_expect))) Then calling ``dune runtest`` will run these tests and in case of mismatch dune will print a diff of the original source file and @@ -174,30 +174,30 @@ the suggested correction. For instance: .. code:: bash - $ dune runtest - [...] - -src/fact.ml - +src/fact.ml.corrected - File "src/fact.ml", line 5, characters 0-1: - let rec fact n = if n = 1 then 1 else n * fact (n - 1) + $ dune runtest + [...] + -src/fact.ml + +src/fact.ml.corrected + File "src/fact.ml", line 5, characters 0-1: + let rec fact n = if n = 1 then 1 else n * fact (n - 1) - let%expect_test _ = - print_int (fact 5); - - [%expect] - + [%expect{| 120 |}] + let%expect_test _ = + print_int (fact 5); + - [%expect] + + [%expect{| 120 |}] In order to accept the correction, simply run: .. code:: bash - $ dune promote + $ dune promote You can also make dune automatically accept the correction after running the tests by typing: .. code:: bash - $ dune runtest --auto-promote + $ dune runtest --auto-promote Finally, some editor integration is possible to make the editor do the promotion and make the workflow even smoother. @@ -234,10 +234,10 @@ For instance: .. code:: ocaml - (library - (name foo) - (inline_tests (modes byte best js)) - (preprocess (pps ppx_expect))) + (library + (name foo) + (inline_tests (modes byte best js)) + (preprocess (pps ppx_expect))) Specifying inline test dependencies ----------------------------------- @@ -248,10 +248,10 @@ a ``deps`` field the ``inline_tests`` field. The argument of this .. code:: ocaml - (library - (name foo) - (inline_tests (deps data.txt)) - (preprocess (pps ppx_expect))) + (library + (name foo) + (inline_tests (deps data.txt)) + (preprocess (pps ppx_expect))) Passing special arguments to the test runner -------------------------------------------- @@ -263,10 +263,30 @@ as: .. code:: ocaml - (library - (name foo) - (inline_tests (flags (-foo bar))) - (preprocess (pps ppx_expect))) + (library + (name foo) + (inline_tests (flags (-foo bar))) + (preprocess (pps ppx_expect))) + +The argument of the ``flags`` field follows the :ref:`ordered-set-language`. + +Passing special arguments to the test executable +------------------------------------------------ + +To control how the test executable is built, it’s possible to customize a subset +of compilation options for an executable using the ``executable`` field. Dune +gives you the right to do that by simply specifying command line arguments as flags. +You can specify such flags by using ``flags`` field. For instance: + +.. code:: ocaml + + (library + (name foo) + (inline_tests + (flags (-foo bar) + (executable + (flags (-foo bar)))) + (preprocess (pps ppx_expect)))) The argument of the ``flags`` field follows the :ref:`ordered-set-language`. @@ -280,10 +300,11 @@ such libraries using a ``libraries`` field, such as: .. code:: ocaml - (library - (name foo) - (inline_tests (backend qtest) - (libraries bar))) + (library + (name foo) + (inline_tests + (backend qtest) + (libraries bar))) Defining your own inline test backend ------------------------------------- @@ -308,10 +329,10 @@ These three parameters can be specified inside the .. code:: scheme - (generate_runner ) - (runner_libraries ()) - (flags ) - (extends ()) + (generate_runner ) + (runner_libraries ()) + (flags ) + (extends ()) For instance: @@ -357,17 +378,16 @@ In this example, we put tests in comments of the form: .. code:: ocaml - (*TEST: assert (fact 5 = 120) *) + (*TEST: assert (fact 5 = 120) *) The backend for such a framework looks like this: .. code:: lisp - (library - (name simple_tests) - (inline_tests.backend - (generate_runner (run sed "s/(\\*TEST:\\(.*\\)\\*)/let () = \\1;;/" %{impl-files})) - )) + (library + (name simple_tests) + (inline_tests.backend + (generate_runner (run sed "s/(\\*TEST:\\(.*\\)\\*)/let () = \\1;;/" %{impl-files})))) Now all you have to do is write ``(inline_tests ((backend simple_tests)))`` wherever you want to write such tests. Note that @@ -385,9 +405,9 @@ running your testsuite, simply add this to a dune file: .. code:: scheme - (rule - (alias runtest) - (action (run ./tests.exe))) + (rule + (alias runtest) + (action (run ./tests.exe))) Hence to define an a test a pair of alias and executable stanzas are required. To simplify this common pattern, dune provides a :ref:`tests-stanza` stanza to @@ -408,12 +428,12 @@ command. For instance let's consider this test: .. code:: scheme - (rule - (with-stdout-to tests.output (run ./tests.exe))) + (rule + (with-stdout-to tests.output (run ./tests.exe))) - (rule - (alias runtest) - (action (diff tests.expected test.output))) + (rule + (alias runtest) + (action (diff tests.expected test.output))) After having run ``tests.exe`` and dumping its output to ``tests.output``, dune will compare the latter to ``tests.expected``. In case of mismatch, dune will @@ -434,15 +454,15 @@ This provides a nice way of dealing with the usual *write code*, .. code:: bash - $ dune runtest - [...] - -tests.expected - +tests.output - File "tests.expected", line 1, characters 0-1: - -Hello, world! - +Good bye! - $ dune promote - Promoting _build/default/tests.output to tests.expected. + $ dune runtest + [...] + -tests.expected + +tests.output + File "tests.expected", line 1, characters 0-1: + -Hello, world! + +Good bye! + $ dune promote + Promoting _build/default/tests.output to tests.expected. Note that if available, the diffing is done using the patdiff_ tool, which displays nicer looking diffs that the standard ``diff`` diff --git a/src/dune_rules/exe_rules.ml b/src/dune_rules/exe_rules.ml index 53c6945bd26..4aec285b19a 100644 --- a/src/dune_rules/exe_rules.ml +++ b/src/dune_rules/exe_rules.ml @@ -87,7 +87,7 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info else l in - let flags = SC.ocaml_flags sctx ~dir exes.buildable in + let flags = SC.ocaml_flags sctx ~dir exes.buildable.flags in let link_deps = Dep_conf_eval.unnamed ~expander exes.link_deps in let foreign_archives = exes.buildable.foreign_archives |> List.map ~f:snd in let link_flags = diff --git a/src/dune_rules/inline_tests.ml b/src/dune_rules/inline_tests.ml index ab972e31c35..32958cd9f66 100644 --- a/src/dune_rules/inline_tests.ml +++ b/src/dune_rules/inline_tests.ml @@ -164,6 +164,7 @@ include Sub_system.Register_end_point (struct ; deps : Dep_conf.t list ; modes : Mode_conf.Set.t ; flags : Ordered_set_lang.Unexpanded.t + ; executable : Ocaml_flags.Spec.t ; backend : (Loc.t * Lib_name.t) option ; libraries : (Loc.t * Lib_name.t) list } @@ -183,6 +184,10 @@ include Sub_system.Register_end_point (struct (let+ loc = loc and+ deps = field "deps" (repeat Dep_conf.decode) ~default:[] and+ flags = Ordered_set_lang.Unexpanded.field "flags" + and+ executable = + field "executable" ~default:Ocaml_flags.Spec.standard + ( Dune_lang.Syntax.since Stanza.syntax (2, 8) + >>> fields Ocaml_flags.Spec.decode ) and+ backend = field_o "backend" (located Lib_name.decode) and+ libraries = field "libraries" (repeat (located Lib_name.decode)) ~default:[] @@ -191,7 +196,7 @@ include Sub_system.Register_end_point (struct (Dune_lang.Syntax.since syntax (1, 11) >>> Mode_conf.Set.decode) ~default:Mode_conf.Set.default in - { loc; deps; flags; backend; libraries; modes }) + { loc; deps; flags; executable; backend; libraries; modes }) (* We don't use this at the moment, but we could implement it for debugging purposes *) @@ -278,11 +283,15 @@ include Sub_system.Register_end_point (struct in Build.With_targets.add ~targets:[ target ] action); let cctx = + let flags = + Ocaml_flags.append_common + (Super_context.ocaml_flags sctx ~dir info.executable) + [ "-w"; "-24"; "-g" ] + in Compilation_context.create () ~super_context:sctx ~expander ~scope ~obj_dir ~modules ~opaque:(Explicit false) ~requires_compile:runner_libs ~requires_link:(lazy runner_libs) - ~flags:(Ocaml_flags.of_list [ "-w"; "-24"; "-g" ]) - ~js_of_ocaml:(Some lib.buildable.js_of_ocaml) ~dynlink:false + ~flags ~js_of_ocaml:(Some lib.buildable.js_of_ocaml) ~dynlink:false ~package:(Option.map lib.public ~f:Dune_file.Public_lib.package) in let linkages = diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index a1086245342..5918678fe7f 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -338,7 +338,7 @@ let cctx (lib : Library.t) ~sctx ~source_modules ~dir ~expander ~scope else Required in - let flags = Super_context.ocaml_flags sctx ~dir lib.buildable in + let flags = Super_context.ocaml_flags sctx ~dir lib.buildable.flags in let obj_dir = Library.obj_dir ~dir lib in let vimpl = Virtual_rules.impl sctx ~lib ~scope in let ctx = Super_context.context sctx in diff --git a/src/dune_rules/super_context.ml b/src/dune_rules/super_context.ml index 4fcc6097ab1..903614406ce 100644 --- a/src/dune_rules/super_context.ml +++ b/src/dune_rules/super_context.ml @@ -317,10 +317,10 @@ let build_dir_is_vendored build_dir = in Option.value ~default:false opt -let ocaml_flags t ~dir (x : Dune_file.Buildable.t) = +let ocaml_flags t ~dir (spec : Ocaml_flags.Spec.t) = let expander = Env_tree.expander t.env_tree ~dir in let flags = - Ocaml_flags.make ~spec:x.flags + Ocaml_flags.make ~spec ~default:(get_node t.env_tree ~dir |> Env_node.ocaml_flags) ~eval:(Expander.expand_and_eval_set expander) in diff --git a/src/dune_rules/super_context.mli b/src/dune_rules/super_context.mli index 3172f017756..ba816b1b907 100644 --- a/src/dune_rules/super_context.mli +++ b/src/dune_rules/super_context.mli @@ -55,8 +55,7 @@ val internal_lib_names : t -> Lib_name.Set.t (** Compute the ocaml flags based on the directory environment and a buildable stanza *) -val ocaml_flags : - t -> dir:Path.Build.t -> Dune_file.Buildable.t -> Ocaml_flags.t +val ocaml_flags : t -> dir:Path.Build.t -> Ocaml_flags.Spec.t -> Ocaml_flags.t val foreign_flags : t diff --git a/test/blackbox-tests/test-cases/inline_tests/executable-flags.t/run.t b/test/blackbox-tests/test-cases/inline_tests/executable-flags.t/run.t new file mode 100644 index 00000000000..29e9929d957 --- /dev/null +++ b/test/blackbox-tests/test-cases/inline_tests/executable-flags.t/run.t @@ -0,0 +1,17 @@ +This test ensures that compilation fails when an invalid option is supplied +to flags field in executable field in inline_tests field. + +First, we pass a valid option to flags field expecting compilation +to be successful. + + $ dune runtest valid_options --root ./test-project + Entering directory 'test-project' + inline_test_runner_valid_option_test alias valid_options/runtest + backend_foo + +Lastly, we pass an invalid option to flags field expecting compilation +to fail. + + $ output=$(dune runtest invalid_options --root ./test-project 2>&1); result=$?; (echo $output | grep -o "unknown option '-option-that-is-not-accepted-by-ocaml'."); (exit $result) + unknown option '-option-that-is-not-accepted-by-ocaml'. + [1] diff --git a/test/blackbox-tests/test-cases/inline_tests/executable-flags.t/test-project/dune b/test/blackbox-tests/test-cases/inline_tests/executable-flags.t/test-project/dune new file mode 100644 index 00000000000..3a3748e56ac --- /dev/null +++ b/test/blackbox-tests/test-cases/inline_tests/executable-flags.t/test-project/dune @@ -0,0 +1,6 @@ +(library + (name backend_foo) + (modules ()) + (inline_tests.backend + (generate_runner + (echo "let () = print_endline \"backend_foo\"")))) diff --git a/test/blackbox-tests/test-cases/inline_tests/executable-flags.t/test-project/dune-project b/test/blackbox-tests/test-cases/inline_tests/executable-flags.t/test-project/dune-project new file mode 100644 index 00000000000..c2e46604eed --- /dev/null +++ b/test/blackbox-tests/test-cases/inline_tests/executable-flags.t/test-project/dune-project @@ -0,0 +1 @@ +(lang dune 2.8) diff --git a/test/blackbox-tests/test-cases/inline_tests/executable-flags.t/test-project/invalid_options/dune b/test/blackbox-tests/test-cases/inline_tests/executable-flags.t/test-project/invalid_options/dune new file mode 100644 index 00000000000..8625b302ee3 --- /dev/null +++ b/test/blackbox-tests/test-cases/inline_tests/executable-flags.t/test-project/invalid_options/dune @@ -0,0 +1,6 @@ +(library + (name invalid_option_test) + (inline_tests + (backend backend_foo) + (executable + (flags -option-that-is-not-accepted-by-ocaml)))) diff --git a/test/blackbox-tests/test-cases/inline_tests/executable-flags.t/test-project/valid_options/dune b/test/blackbox-tests/test-cases/inline_tests/executable-flags.t/test-project/valid_options/dune new file mode 100644 index 00000000000..0808ef48125 --- /dev/null +++ b/test/blackbox-tests/test-cases/inline_tests/executable-flags.t/test-project/valid_options/dune @@ -0,0 +1,6 @@ +(library + (name valid_option_test) + (inline_tests + (backend backend_foo) + (executable + (flags -nolabels))))