From 513d90203708d9607288258676fc2b0a95aae2c3 Mon Sep 17 00:00:00 2001 From: Ali Caglayan Date: Mon, 27 Oct 2025 08:35:53 +0000 Subject: [PATCH 1/2] refactor: add Tests variant to Ml_sources.Origin.t Signed-off-by: Ali Caglayan --- src/dune_rules/ml_sources.ml | 70 ++++++++++++++++++++++++++--------- src/dune_rules/ml_sources.mli | 1 + src/dune_rules/top_module.ml | 1 + 3 files changed, 54 insertions(+), 18 deletions(-) diff --git a/src/dune_rules/ml_sources.ml b/src/dune_rules/ml_sources.ml index 389f156a1a2..d1784c596c3 100644 --- a/src/dune_rules/ml_sources.ml +++ b/src/dune_rules/ml_sources.ml @@ -5,23 +5,27 @@ module Origin = struct type t = | Library of Library.t | Executables of Executables.t + | Tests of Tests.t | Melange of Melange_stanzas.Emit.t let loc = function | Library l -> l.buildable.loc | Executables e -> e.buildable.loc + | Tests t -> t.exes.buildable.loc | Melange mel -> mel.loc ;; let preprocess = function | Library l -> l.buildable.preprocess | Executables e -> e.buildable.preprocess + | Tests t -> t.exes.buildable.preprocess | Melange mel -> mel.preprocess ;; let to_dyn = function | Library _ -> Dyn.variant "Library" [ Dyn.Opaque ] | Executables _ -> Dyn.variant "Executables" [ Dyn.Opaque ] + | Tests _ -> Dyn.variant "Tests" [ Dyn.Opaque ] | Melange _ -> Dyn.variant "Melange" [ Dyn.Opaque ] ;; end @@ -58,10 +62,11 @@ module Per_stanza = struct type groups = { libraries : Library.t group_part list ; executables : Executables.t group_part list + ; tests : Tests.t group_part list ; melange_emits : Melange_stanzas.Emit.t group_part list } - let make { libraries = libs; executables = exes; melange_emits = emits } = + let make { libraries = libs; executables = exes; tests; melange_emits = emits } = let libraries, libraries_by_obj_dir = List.fold_left libs @@ -84,17 +89,29 @@ module Per_stanza = struct by_id, by_obj_dir) in let executables = - match - String.Map.of_list_map exes ~f:(fun (part : Executables.t group_part) -> - let first_exe = snd (Nonempty_list.hd part.stanza.names) in - let origin : Origin.t = Executables part.stanza in - first_exe, (origin, part.modules, part.obj_dir)) - with - | Ok x -> x - | Error (name, _, part) -> + let entries = + List.concat + [ List.map exes ~f:(fun (part : Executables.t group_part) -> + let first_exe = snd (Nonempty_list.hd part.stanza.names) in + let origin : Origin.t = Executables part.stanza in + first_exe, (origin, part.modules, part.obj_dir, part.stanza.buildable.loc)) + ; List.map tests ~f:(fun (part : Tests.t group_part) -> + let first_exe = snd (Nonempty_list.hd part.stanza.exes.names) in + let origin : Origin.t = Tests part.stanza in + ( first_exe + , (origin, part.modules, part.obj_dir, part.stanza.exes.buildable.loc) )) + ] + in + match String.Map.of_list entries with + | Ok map -> + String.Map.map map ~f:(fun (origin, modules, obj_dir, _loc) -> + origin, modules, obj_dir) + | Error (name, (_, _, _, loc1), (_, _, _, loc2)) -> User_error.raise - ~loc:part.stanza.buildable.loc - [ Pp.textf "Executable %S appears for the second time in this directory" name ] + ~loc:loc1 + [ Pp.textf "Executable %S appears for the second time in this directory" name + ; Pp.textf "Already defined at %s" (Loc.to_file_colon_line loc2) + ] in let melange_emits = match @@ -118,6 +135,8 @@ module Per_stanza = struct by_path (Library part.stanza, part.dir) part.sources) ; List.rev_concat_map exes ~f:(fun part -> by_path (Executables part.stanza, part.dir) part.sources) + ; List.rev_concat_map tests ~f:(fun part -> + by_path (Tests part.stanza, part.dir) part.sources) ; List.rev_concat_map emits ~f:(fun part -> by_path (Melange part.stanza, part.dir) part.sources) ] @@ -252,7 +271,7 @@ let find_origin (t : t) ~libs path = | Some origins -> Memo.List.filter_map origins ~f:(fun (origin, dir) -> match origin with - | Executables _ | Melange _ -> Memo.return (Some origin) + | Executables _ | Tests _ | Melange _ -> Memo.return (Some origin) | Library lib -> let src_dir = Path.drop_optional_build_context_src_exn (Path.build dir) in Lib.DB.available_by_lib_id libs (Local (Library.to_lib_id ~src_dir lib)) @@ -461,14 +480,18 @@ let modules_of_stanzas = | `Skip -> loop l acc | `Library y -> loop l { acc with libraries = y :: acc.libraries } | `Executables y -> loop l { acc with executables = y :: acc.executables } + | `Tests y -> loop l { acc with tests = y :: acc.tests } | `Melange_emit y -> loop l { acc with melange_emits = y :: acc.melange_emits }) in - fun l -> loop l { libraries = []; executables = []; melange_emits = [] } + fun l -> loop l { libraries = []; executables = []; tests = []; melange_emits = [] } in fun l -> - let { Per_stanza.libraries; executables; melange_emits } = rev_filter_partition l in + let { Per_stanza.libraries; executables; tests; melange_emits } = + rev_filter_partition l + in { Per_stanza.libraries = List.rev libraries ; executables = List.rev executables + ; tests = List.rev tests ; melange_emits = List.rev melange_emits } in @@ -496,6 +519,12 @@ let modules_of_stanzas = in `Executables { Per_stanza.stanza = exes; sources; modules; obj_dir; dir } in + let make_tests ~dir ~expander ~modules ~project tests = + let+ result = make_executables ~dir ~expander ~modules ~project tests.Tests.exes in + match result with + | `Executables group_part -> `Tests { group_part with stanza = tests } + | _ -> assert false + in fun stanzas ~expander ~project ~dir ~libs ~lookup_vlib ~modules ~include_subdirs -> Memo.parallel_map stanzas ~f:(fun stanza -> let enabled_if = @@ -532,7 +561,7 @@ let modules_of_stanzas = let obj_dir = Library.obj_dir lib ~dir in `Library { Per_stanza.stanza = lib; sources; modules; dir; obj_dir } | Executables.T exes -> make_executables ~dir ~expander ~modules ~project exes - | Tests.T { exes; _ } -> make_executables ~dir ~expander ~modules ~project exes + | Tests.T tests -> make_tests ~dir ~expander ~modules ~project tests | Melange_stanzas.Emit.T mel -> let obj_dir = Obj_dir.make_melange_emit ~dir ~name:mel.target in let+ sources, modules = @@ -652,9 +681,14 @@ let make part.stanza, part.modules, part.obj_dir) in let exes = - List.map - modules_of_stanzas.executables - ~f:(fun (part : _ Per_stanza.group_part) -> part.modules, part.obj_dir) + List.concat + [ List.map + modules_of_stanzas.executables + ~f:(fun { Per_stanza.modules; obj_dir; _ } -> modules, obj_dir) + ; List.map + modules_of_stanzas.tests + ~f:(fun { Per_stanza.modules; obj_dir; _ } -> modules, obj_dir) + ] in Artifacts_obj.make ~dir diff --git a/src/dune_rules/ml_sources.mli b/src/dune_rules/ml_sources.mli index 7b08c4388f3..9c5d4fde3c9 100644 --- a/src/dune_rules/ml_sources.mli +++ b/src/dune_rules/ml_sources.mli @@ -8,6 +8,7 @@ module Origin : sig type t = | Library of Library.t | Executables of Executables.t + | Tests of Tests.t | Melange of Melange_stanzas.Emit.t val preprocess : t -> Preprocess.With_instrumentation.t Preprocess.Per_module.t diff --git a/src/dune_rules/top_module.ml b/src/dune_rules/top_module.ml index aeed5582f97..3915455f4ca 100644 --- a/src/dune_rules/top_module.ml +++ b/src/dune_rules/top_module.ml @@ -42,6 +42,7 @@ let find_module sctx src = @@ fun () -> match origin with | Executables exes -> Exe_rules.rules ~sctx ~dir_contents ~scope ~expander exes + | Tests tests -> Exe_rules.rules ~sctx ~dir_contents ~scope ~expander tests.exes | Library lib -> Lib_rules.rules lib ~sctx ~dir_contents ~expander ~scope | Melange mel -> Melange_rules.setup_emit_cmj_rules ~sctx ~dir_contents ~expander ~scope mel From ea89299851286e17903ed4e1307b72129506abd7 Mon Sep 17 00:00:00 2001 From: Ali Caglayan Date: Sat, 1 Nov 2025 00:42:53 +0000 Subject: [PATCH 2/2] feat(runtest): dune runtest for (inline_tests) Signed-off-by: Ali Caglayan --- bin/import.ml | 2 + bin/runtest_common.ml | 50 ++++++--- .../test-cases/runtest-cmd-inline-tests.t | 100 ++++++++++++++++++ 3 files changed, 136 insertions(+), 16 deletions(-) create mode 100644 test/blackbox-tests/test-cases/runtest-cmd-inline-tests.t diff --git a/bin/import.ml b/bin/import.ml index 1fabf7b125c..152e8ba68dd 100644 --- a/bin/import.ml +++ b/bin/import.ml @@ -41,6 +41,8 @@ include struct module Executables = Executables module Dune_load = Dune_load module Dir_contents = Dir_contents + module Sub_system_name = Sub_system_name + module Inline_tests_info = Inline_tests_info end include struct diff --git a/bin/runtest_common.ml b/bin/runtest_common.ml index 00ea6eae08d..9c1e5220e86 100644 --- a/bin/runtest_common.ml +++ b/bin/runtest_common.ml @@ -5,6 +5,7 @@ module Test_kind = struct | Runtest of Path.t | Cram of Path.t * Source.Cram_test.t | Test_executable of Path.t * string (* dir, executable name *) + | Inline_tests of Path.t * string (* dir, library name *) let alias ~contexts = function | Cram (dir, cram) -> @@ -15,6 +16,10 @@ module Test_kind = struct runtst aliases? *) let name = Dune_engine.Alias.Name.of_string ("runtest-" ^ exe_name) in Alias.in_dir ~name ~recursive:false ~contexts dir + | Inline_tests (dir, lib_name) -> + (* CR-someday Alizter: get the proper alias where it is defined. *) + let name = Dune_engine.Alias.Name.of_string ("runtest-" ^ lib_name) in + Alias.in_dir ~name ~recursive:false ~contexts dir | Runtest dir -> Alias.in_dir ~name:Dune_rules.Alias.runtest ~recursive:true ~contexts dir ;; @@ -40,7 +45,13 @@ let find_cram_test cram_tests path = | Error (Dune_rules.Cram_rules.Missing_run_t _) | Ok _ -> None) ;; -let find_test_executable ~sctx ~dir ~ml_file = +let has_inline_tests (lib : Dune_rules.Library.t) = + Dune_rules.Sub_system_name.Map.mem + lib.sub_systems + Dune_rules.Inline_tests_info.Tests.name +;; + +let classify_ml_test ~sctx ~dir ~ml_file = let open Memo.O in let module_name = Filename.remove_extension ml_file in match Dune_lang.Module_name.of_string_opt module_name with @@ -57,14 +68,17 @@ let find_test_executable ~sctx ~dir ~ml_file = ~libs:(Dune_rules.Scope.libs scope) [ module_name ] >>| (function + | Some (Library lib) when has_inline_tests lib -> + let lib_name = snd lib.name |> Lib_name.Local.to_string in + Ok (`Inline_tests_library lib_name) | Some (Library _ | Executables _ | Melange _) | None -> Error `Not_a_test | Some (Tests ({ exes; _ } as _test)) -> let exe_names = Nonempty_list.to_list exes.names |> List.map ~f:snd in if List.mem exe_names (Filename.remove_extension ml_file) ~equal:String.equal - then Ok (Filename.remove_extension ml_file) + then Ok (`Test_executable (Filename.remove_extension ml_file)) else ( match exe_names with - | [ single_exe ] -> Ok single_exe + | [ single_exe ] -> Ok (`Test_executable single_exe) | [] | _ :: _ -> Error `Not_an_entry_point)) ;; @@ -84,7 +98,7 @@ let all_tests_of_dir ~sctx parent_dir = |> Filename.Set.to_list |> List.filter ~f:(fun f -> String.is_suffix f ~suffix:".ml") |> Memo.List.filter ~f:(fun ml_file -> - find_test_executable ~sctx ~dir:parent_dir ~ml_file >>| Result.is_ok) + classify_ml_test ~sctx ~dir:parent_dir ~ml_file >>| Result.is_ok) and+ dir_candidates = let* parent_source_dir = Source_tree.find_dir parent_dir in match parent_source_dir with @@ -126,22 +140,26 @@ let disambiguate_test_name ~sctx path = | None -> (* Check for test executables *) let filename = Path.Source.basename path in - let* test_exe_opt = - find_test_executable ~sctx ~dir:parent_dir ~ml_file:filename + let* test_kind_opt = + classify_ml_test ~sctx ~dir:parent_dir ~ml_file:filename >>| function - | Ok exe_name -> Some exe_name - | Error `Not_an_entry_point -> - User_error.raise - [ Pp.textf - "%S is used by multiple test executables and cannot be run directly." - filename - ] - | Error `Not_a_test -> None + | Ok (`Test_executable exe_name) -> Some (`Test_exe exe_name) + | Ok (`Inline_tests_library lib_name) -> Some (`Inline_tests lib_name) + | Error `Not_an_entry_point -> + User_error.raise + [ Pp.textf + "%S is used by multiple test executables and cannot be run directly." + filename + ] + | Error `Not_a_test -> None in - (match test_exe_opt with - | Some exe_name -> + (match test_kind_opt with + | Some (`Test_exe exe_name) -> (* Found a test executable for this ML file *) Memo.return (Test_kind.Test_executable (Path.source parent_dir, exe_name)) + | Some (`Inline_tests lib_name) -> + (* Found an inline tests library for this ML file *) + Memo.return (Test_kind.Inline_tests (Path.source parent_dir, lib_name)) | None -> (* If we don't find it, then we assume the user intended a directory for @runtest to be used. *) diff --git a/test/blackbox-tests/test-cases/runtest-cmd-inline-tests.t b/test/blackbox-tests/test-cases/runtest-cmd-inline-tests.t new file mode 100644 index 00000000000..757307f3925 --- /dev/null +++ b/test/blackbox-tests/test-cases/runtest-cmd-inline-tests.t @@ -0,0 +1,100 @@ +Test running inline tests by specifying ML source files directly. + + $ cat > dune-project < (lang dune 3.21) + > EOF + +Set up a simple inline tests backend and libraries: + + $ cat > dune < (library + > (name test_backend) + > (modules ()) + > (inline_tests.backend + > (generate_runner (run sed "s/(\\\\*TEST:\\\\(.*\\\\)\\\\*)/let () = if \\"%{inline_tests}\\" = \\"enabled\\" then \\\\1;;/" %{impl-files})))) + > + > (library + > (name mylib) + > (modules lib) + > (inline_tests (backend test_backend))) + > + > (library + > (name regular_lib) + > (modules regular)) + > EOF + + $ cat > lib.ml < let add x y = x + y + > (*TEST: assert false *) + > EOF + + $ cat > regular.ml < let subtract x y = x - y + > EOF + +Error when specifying a library ML file without inline_tests: + + $ dune test regular.ml + Error: "regular.ml" does not match any known test. + [1] + +When specifying a library with inline_tests, it should run the test (and fail): + + $ dune test lib.ml + File "dune", line 10, characters 1-38: + 10 | (inline_tests (backend test_backend))) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Fatal error: exception File ".mylib.inline-tests/main.ml-gen", line 2, characters 40-46: Assertion failed + [1] + +Error when specifying a non-existent ML file: + + $ dune test nonexistent.ml + Error: "nonexistent.ml" does not match any known test. + [1] + +Test that inline tests are included in suggestions: + + $ dune test li.ml + Error: "li.ml" does not match any known test. + Hint: did you mean lib.ml? + [1] + +Can run inline tests from _build directory: + + $ dune test _build/default/lib.ml + File "dune", line 10, characters 1-38: + 10 | (inline_tests (backend test_backend))) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Fatal error: exception File ".mylib.inline-tests/main.ml-gen", line 2, characters 40-46: Assertion failed + [1] + +Test with multiple contexts: + + $ cat > dune-workspace < (lang dune 3.20) + > (context (default)) + > (context (default (name alt))) + > EOF + +Running inline tests in multiple contexts: + + $ dune test lib.ml + File "dune", line 10, characters 1-38: + 10 | (inline_tests (backend test_backend))) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Fatal error: exception File ".mylib.inline-tests/main.ml-gen", line 2, characters 40-46: Assertion failed + File "dune", line 10, characters 1-38: + 10 | (inline_tests (backend test_backend))) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Fatal error: exception File ".mylib.inline-tests/main.ml-gen", line 2, characters 40-46: Assertion failed + [1] + +Running inline tests in a specific build directory: + + $ dune test _build/alt/lib.ml + File "dune", line 10, characters 1-38: + 10 | (inline_tests (backend test_backend))) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Fatal error: exception File ".mylib.inline-tests/main.ml-gen", line 2, characters 40-46: Assertion failed + [1]