feat(runtest): dune runtest for (inline_tests)

Signed-off-by: Ali Caglayan <[email protected]>

Author: Alizter

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

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
+       `Inline_tests_library lib_name
      | Some (Library _ | Executables _ | Melange _) | None -> `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 `Runnable (Filename.remove_extension ml_file)
+       then `Test_executable (Filename.remove_extension ml_file)
        else (
          match exe_names with
-         | [ single_exe ] -> `Runnable single_exe
+         | [ single_exe ] -> `Test_executable single_exe
          | [] | _ :: _ -> `Multiple_executables))
 ;;
 
@@ -84,9 +98,9 @@ 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
+        classify_ml_test ~sctx ~dir:parent_dir ~ml_file
         >>| function
-        | `Runnable _ -> true
+        | `Test_executable _ | `Inline_tests_library _ -> true
         | `Multiple_executables | `Not_a_test -> false)
   and+ dir_candidates =
     let* parent_source_dir = Source_tree.find_dir parent_dir in
@@ -129,19 +143,23 @@ 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
-         | `Runnable exe_name -> Some exe_name
+         | `Test_executable exe_name -> Some (`Test_exe exe_name)
+         | `Inline_tests_library lib_name -> Some (`Inline_tests lib_name)
          | `Multiple_executables ->
            User_error.raise
              [ Pp.text "Running multiple test executables at once is not yet supported" ]
          | `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. *)

src/dune_rules/dune_rules.ml

@@ -64,6 +64,8 @@ module Pkg_build_progress = Pkg_build_progress
 module Compile_time = Compile_time
 module Cram_rules = Cram_rules
 module Instrumentation = Instrumentation
+module Sub_system_name = Sub_system_name
+module Inline_tests_info = Inline_tests_info
 
 module Install_rules = struct
   let install_file = Install_rules.install_file

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 <<EOF
+  > (lang dune 3.21)
+  > EOF
+
+Set up a simple inline tests backend and libraries:
+
+  $ cat > dune <<EOF
+  > (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 <<EOF
+  > let add x y = x + y
+  > (*TEST: assert false *)
+  > EOF
+
+  $ cat > regular.ml <<EOF
+  > 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 <<EOF
+  > (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]