feat(runtest): dune runtest for (tests) and (inline_tests)

Signed-off-by: Ali Caglayan <alizter@gmail.com>

Author: Alizter

bin/build.ml

@@ -99,7 +99,7 @@ let poll_handling_rpc_build_requests ~(common : Common.t) =
          | Build targets -> Target.interpret_targets (Common.root common) setup targets
          | Runtest test_paths ->
            Runtest_common.make_request
-             ~contexts:setup.contexts
+             ~scontexts:setup.scontexts
              ~to_cwd:root.to_cwd
              ~test_paths
        in

bin/import.ml

@@ -39,6 +39,7 @@ include struct
   module Library = Library
   module Melange = Melange
   module Executables = Executables
+  module Dir_contents = Dir_contents
 end
 
 include struct

bin/runtest.ml

@@ -43,7 +43,7 @@ let runtest_term =
   | Ok () ->
     Build.run_build_command ~common ~config ~request:(fun setup ->
       Runtest_common.make_request
-        ~contexts:setup.contexts
+        ~scontexts:setup.scontexts
         ~to_cwd:(Common.root common).to_cwd
         ~test_paths)
   | Error lock_held_by ->

bin/runtest_common.ml

@@ -4,11 +4,27 @@ module Test_kind = struct
   type t =
     | Runtest of Path.t
     | Cram of Path.t * Source.Cram_test.t
+    | Test_executable of
+        { dir : Path.t
+        ; exe_name : string
+        }
+    | Inline_tests of
+        { dir : Path.t
+        ; lib_name : Lib_name.Local.t
+        }
 
   let alias ~contexts = function
     | Cram (dir, cram) ->
       let name = Dune_engine.Alias.Name.of_string (Source.Cram_test.name cram) in
       Alias.in_dir ~name ~recursive:false ~contexts dir
+    | Test_executable { dir; exe_name } ->
+      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 } ->
+      let name =
+        Dune_engine.Alias.Name.of_string ("runtest-" ^ Lib_name.Local.to_string 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
   ;;
@@ -34,13 +50,65 @@ let find_cram_test cram_tests path =
     | Error (Dune_rules.Cram_rules.Missing_run_t _) | Ok _ -> None)
 ;;
 
-let all_tests_of_dir parent_dir =
+(** [classify_ml_test ~sctx ~dir ~ml_file] checks if [ml_file] is part of a
+    (tests) or (library (inline_tests ...)) stanza in [dir]. Returns:
+    - [Ok (`Test_executable exe_name)] or [Ok (`Inline_tests_library lib_name)]
+    - [Error `Not_an_entry_point] if the file belongs to a multi-test stanza
+    - [Error `Not_a_test] if not part of any test stanza *)
+let classify_ml_test ~sctx ~dir ~ml_file =
+  let open Memo.O in
+  let ml_file_no_ext = Filename.remove_extension ml_file in
+  match Dune_lang.Module_name.of_string_opt ml_file_no_ext with
+  | None -> Memo.return (Error `Not_a_test)
+  | Some module_name ->
+    let* dir_contents =
+      Dir_contents.get
+        sctx
+        ~dir:
+          (Path.Build.append_source (Context.build_dir (Super_context.context sctx)) dir)
+    in
+    let* ml_sources = Dir_contents.ocaml dir_contents
+    and* scope = Dir_contents.dir dir_contents |> Dune_rules.Scope.DB.find_by_dir in
+    Dune_rules.Ml_sources.find_origin
+      ml_sources
+      ~libs:(Dune_rules.Scope.libs scope)
+      [ module_name ]
+    >>| (function
+     | Some (Library lib) ->
+       if
+         Dune_rules.Sub_system_name.Map.mem
+           lib.sub_systems
+           Dune_rules.Inline_tests_info.Tests.name
+       then Ok (`Inline_tests_library (snd lib.name))
+       else Error `Not_a_test
+     | Some (Executables _ | Melange _) | None -> Error `Not_a_test
+     | Some (Tests { exes; _ }) ->
+       let exe_names = Nonempty_list.to_list exes.names |> List.map ~f:snd in
+       if List.mem exe_names ml_file_no_ext ~equal:String.equal
+       then Ok (`Test_executable ml_file_no_ext)
+       else (
+         match exe_names with
+         | [ single_exe ] -> Ok (`Test_executable single_exe)
+         | [] | _ :: _ :: _ -> Error `Not_an_entry_point))
+;;
+
+let all_tests_of_dir ~sctx parent_dir =
   let open Memo.O in
   let+ cram_candidates =
     cram_tests_of_dir parent_dir
     >>| List.filter_map ~f:(fun res ->
       Result.to_option res
       |> Option.map ~f:(fun test -> Source.Cram_test.path test |> Path.Source.to_string))
+  and+ ml_test_candidates =
+    Source_tree.find_dir parent_dir
+    >>= function
+    | None -> Memo.return []
+    | Some source_dir ->
+      Source_tree.Dir.filenames source_dir
+      |> Filename.Set.to_list
+      |> List.filter ~f:(String.is_suffix ~suffix:".ml")
+      |> Memo.List.filter ~f:(fun ml_file ->
+        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
@@ -53,23 +121,22 @@ let all_tests_of_dir parent_dir =
         >>| Source_tree.Dir.path
         >>| Path.Source.to_string)
   in
-  List.concat [ cram_candidates; dir_candidates ]
+  List.concat [ cram_candidates; ml_test_candidates; dir_candidates ]
   |> String.Set.of_list
   |> String.Set.to_list
 ;;
 
-let explain_unsuccessful_search path ~parent_dir =
+let explain_unsuccessful_search ~sctx path ~parent_dir =
   let open Memo.O in
-  let+ candidates = all_tests_of_dir parent_dir in
+  let+ candidates = all_tests_of_dir ~sctx parent_dir in
   User_error.raise
     ~hints:(User_message.did_you_mean (Path.Source.to_string path) ~candidates)
     [ Pp.textf "%S does not match any known test." (Path.Source.to_string path) ]
 ;;
 
-(* [disambiguate_test_name path] is a function that takes in a
-   directory [path] and classifies it as either a cram test or a directory to
-   run tests in. *)
-let disambiguate_test_name path =
+(* [disambiguate_test_name ~sctx path] classifies [path] as a cram test,
+   ml test executable, inline tests library, or a directory to run @runtest in. *)
+let disambiguate_test_name ~sctx path =
   match Path.Source.parent path with
   | None -> Memo.return @@ Test_kind.Runtest (Path.source Path.Source.root)
   | Some parent_dir ->
@@ -80,27 +147,50 @@ let disambiguate_test_name path =
        (* If we find the cram test, then we request that is run. *)
        Memo.return (Test_kind.Cram (Path.source parent_dir, test))
      | None ->
-       (* If we don't find it, then we assume the user intended a directory for
-          @runtest to be used. *)
-       Source_tree.find_dir path
-       >>= (function
-        (* We need to make sure that this directory or file exists. *)
-        | Some _ -> Memo.return (Test_kind.Runtest (Path.source path))
-        | None -> explain_unsuccessful_search path ~parent_dir))
+       (* Check if it's an ML test file *)
+       let filename = Path.Source.basename path in
+       let* ml_test =
+         if String.is_suffix filename ~suffix:".ml"
+         then classify_ml_test ~sctx ~dir:parent_dir ~ml_file:filename
+         else Memo.return (Error `Not_a_test)
+       in
+       (match ml_test with
+        | Ok (`Test_executable exe_name) ->
+          Memo.return
+            (Test_kind.Test_executable { dir = Path.source parent_dir; exe_name })
+        | Ok (`Inline_tests_library lib_name) ->
+          Memo.return (Test_kind.Inline_tests { dir = Path.source parent_dir; 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 ->
+          (* Assume the user intended a directory for @runtest to be used. *)
+          Source_tree.find_dir path
+          >>= (function
+           (* We need to make sure that this directory or file exists. *)
+           | Some _ -> Memo.return (Test_kind.Runtest (Path.source path))
+           | None -> explain_unsuccessful_search ~sctx path ~parent_dir)))
 ;;
 
-let make_request ~contexts ~to_cwd ~test_paths =
+let make_request ~scontexts ~to_cwd ~test_paths =
+  let contexts =
+    Context_name.Map.to_list_map scontexts ~f:(fun _ -> Super_context.context)
+  in
   List.map test_paths ~f:(fun dir ->
     let dir = Path.of_string dir |> Path.Expert.try_localize_external in
-    let contexts, src_dir =
+    let sctx, contexts, src_dir =
       match (Util.check_path contexts dir : Util.checked) with
-      | In_build_dir (context, dir) -> [ context ], dir
+      | In_build_dir (context, dir) ->
+        Context_name.Map.find_exn scontexts (Context.name context), [ context ], dir
       | In_source_dir dir ->
         (* We need to adjust the path here to make up for the current working directory. *)
         let dir =
           Path.Source.L.relative Path.Source.root (to_cwd @ Path.Source.explode dir)
         in
-        contexts, dir
+        Context_name.Map.find_exn scontexts Context_name.default, contexts, dir
       | In_private_context _ | In_install_dir _ ->
         User_error.raise
           [ Pp.textf "This path is internal to dune: %s" (Path.to_string_maybe_quoted dir)
@@ -113,7 +203,7 @@ let make_request ~contexts ~to_cwd ~test_paths =
           ]
     in
     let open Action_builder.O in
-    Action_builder.of_memo (disambiguate_test_name src_dir)
+    Action_builder.of_memo (disambiguate_test_name ~sctx src_dir)
     >>| Test_kind.alias ~contexts
     >>= Alias.request)
   |> Action_builder.all_unit

bin/runtest_common.mli

@@ -1,7 +1,7 @@
 open Import
 
 val make_request
-  :  contexts:Context.t list
+  :  scontexts:Super_context.t Context_name.Map.t
   -> to_cwd:string list
   -> test_paths:string list
   -> unit Action_builder.t

doc/changes/added/13064.md

@@ -0,0 +1,3 @@
+- `dune runtest` can now run individual test executables from `(tests)` stanzas
+  and inline tests from `(library (inline_tests))` stanzas by providing their
+  source files as arguments. (#13064, fixes #870, @Alizter)

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,16 +89,26 @@ 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
+          ~loc:loc1
           [ Pp.textf "Executable %S appears for the second time in this directory" name ]
     in
     let melange_emits =
@@ -118,6 +133,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 +269,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))
@@ -469,14 +486,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
@@ -505,6 +526,11 @@ 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 }
+  in
   fun stanzas ~expander ~project ~dir ~libs ~lookup_vlib ~modules ~include_subdirs ->
     Memo.parallel_map stanzas ~f:(fun stanza ->
       let enabled_if =
@@ -541,7 +567,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 =
@@ -665,9 +691,11 @@ 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)
+        let modules_and_obj_dir { Per_stanza.modules; obj_dir; _ } = modules, obj_dir in
+        List.concat
+          [ List.map modules_of_stanzas.executables ~f:modules_and_obj_dir
+          ; List.map modules_of_stanzas.tests ~f:modules_and_obj_dir
+          ]
       in
       Artifacts_obj.make
         ~dir

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