feature: dune runtest can run individual tests

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

bin/runtest.ml

@@ -4,11 +4,24 @@ let runtest_info =
   let doc = "Run tests." in
   let man =
     [ `S "DESCRIPTION"
-    ; `P {|This is a short-hand for calling:|}
-    ; `Pre {|  dune build @runtest|}
+    ; `P "Run the given tests. The [TEST] argument can be either:"
+    ; `I
+        ( "-"
+        , "A directory: If a directory is provided, dune will recursively run all tests \
+           within that directory." )
+    ; `I
+        ( "-"
+        , "A file name: If a specific file name is provided, dune will run the tests \
+           with that name." )
+    ; `P
+        "If no [TEST] is provided, dune will run all tests in the current directory and \
+         its subdirectories."
+    ; `P "See EXAMPLES below for additional information on use cases."
     ; `Blocks Common.help_secs
     ; Common.examples
-        [ ( "Run all tests in the current source tree (including those that passed on \
+        [ "Run all tests in a given directory", "dune runtest path/to/dir/"
+        ; "Run a specific cram test", "dune runtest path/to/mytest.t"
+        ; ( "Run all tests in the current source tree (including those that passed on \
              the last run)"
           , "dune runtest --force" )
         ; ( "Run tests sequentially without output buffering"
@@ -19,21 +32,93 @@ let runtest_info =
   Cmd.info "runtest" ~doc ~man ~envs:Common.envs
 ;;
 
+let find_cram_test path ~parent_dir =
+  let open Memo.O in
+  Source_tree.nearest_dir parent_dir
+  >>= Dune_rules.Cram_rules.cram_tests
+  (* We ignore the errors we get when searching for cram tests as they will
+     be reported during building anyway. We are only interested in the
+     presence of cram tests. *)
+  >>| List.filter_map ~f:Result.to_option
+  (* We search our list of known cram tests for the test we are looking
+     for. *)
+  >>| List.find ~f:(fun (test : Dune_rules.Cram_test.t) ->
+    let src =
+      match test with
+      | File src -> src
+      | Dir { dir = src; _ } -> src
+    in
+    Path.Source.equal path src)
+;;
+
+(** [disambiguate_test_name path] is a memoized 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 =
+  match Path.Source.parent path with
+  | None -> Memo.return @@ `Runtest (Path.source Path.Source.root)
+  | Some parent_dir ->
+    let open Memo.O in
+    find_cram_test path ~parent_dir
+    >>= (function
+     (* If we find the cram test, then we request that is run. *)
+     | Some test ->
+       Memo.return (`Test (Dune_rules.Cram_test.name test))
+       (* If we don't find it, then we assume the user intended a directory for
+          @runtest to be used. *)
+     | None ->
+       Source_tree.find_dir path
+       >>= (function
+        (* We need to make sure that this directory or file exists. *)
+        | Some _ -> Memo.return (`Runtest (Path.source path))
+        | None ->
+          (* If the user misspelled the test name, we give them a hint. *)
+          let+ hints =
+            let+ candidates =
+              let+ files = Source_tree.files_of parent_dir in
+              Path.Source.Set.to_list_map files ~f:Path.Source.basename
+            in
+            User_message.did_you_mean (Path.Source.basename path) ~candidates
+          in
+          User_error.raise
+            ~hints
+            [ Pp.textf "%S was not found." (Path.Source.to_string path) ]))
+;;
+
 let runtest_term =
-  let name_ = Arg.info [] ~docv:"DIR" in
+  let name = Arg.info [] ~docv:"TEST" in
   let+ builder = Common.Builder.term
-  and+ dirs = Arg.(value & pos_all string [ "." ] name_) in
+  and+ dirs = Arg.(value & pos_all string [ "." ] name) in
   let common, config = Common.init builder in
   let request (setup : Import.Main.build_system) =
-    Action_builder.all_unit
-      (List.map dirs ~f:(fun dir ->
-         let dir = Path.(relative root) (Common.prefix_target common dir) in
-         Alias.in_dir
-           ~name:Dune_rules.Alias.runtest
-           ~recursive:true
-           ~contexts:setup.contexts
-           dir
-         |> Alias.request))
+    List.map dirs ~f:(fun dir ->
+      let open Action_builder.O in
+      let* alias_kind =
+        (* We always interpret the arguments as paths *)
+        let dir = Path.of_string dir in
+        match Path.as_in_source_tree dir with
+        | Some path -> Action_builder.of_memo (disambiguate_test_name path)
+        | None ->
+          (* If the path is in the source tree, we disambiguate it. *)
+          Action_builder.return (`Runtest dir)
+      in
+      (* In either case, we just call the alias. *)
+      Alias.request
+      @@
+      match alias_kind with
+      | `Test alias_name ->
+        Alias.of_string
+          (Common.root common)
+          ~recursive:false
+          ~contexts:setup.contexts
+          alias_name
+      | `Runtest dir ->
+        Alias.in_dir
+          ~name:Dune_rules.Alias.runtest
+          ~recursive:true
+          ~contexts:setup.contexts
+          dir)
+    |> Action_builder.all_unit
   in
   Build_cmd.run_build_command ~common ~config ~request
 ;;

doc/changes/11041.md

@@ -0,0 +1,2 @@
+- `dune runtest` can now run individual tests with `dune runtest mytest.t`
+  (#11041, @Alizter).

src/dune_rules/cram/cram_rules.mli

@@ -2,4 +2,11 @@
 
 open Import
 
+(** The type of errors that can occur when searching for cram tests *)
+type error
+
+(** Memoized list of cram tests in a directory. *)
+val cram_tests : Source_tree.Dir.t -> (Cram_test.t, error) result list Memo.t
+
+(** Cram test rules *)
 val rules : sctx:Super_context.t -> dir:Path.Build.t -> Source_tree.Dir.t -> unit Memo.t

src/dune_rules/dune_rules.ml

@@ -72,6 +72,8 @@ module Stanzas = Stanzas
 module Lock_dir = Lock_dir
 module Pkg_dev_tool = Pkg_dev_tool
 module Pkg_build_progress = Pkg_build_progress
+module Cram_rules = Cram_rules
+module Cram_test = Cram_test
 
 module Install_rules = struct
   let install_file = Install_rules.install_file

test/blackbox-tests/test-cases/runtest-cmd.t

@@ -13,36 +13,68 @@ Here we test the features of the `dune runtest` command.
   >   $ echo "Hello, world!"
   > "Goodbye, world!"
   > EOF
+  $ cat > tests/filetest.t <<EOF
+  >   $ echo "Hello, world!"
+  > "Goodbye, world!"
+  > EOF
 
 Passing no arguments to `dune runtest` should be equivalent to `dune build
 @runtest`.
 
   $ dune test 2>&1 | grep "^File"
   File "mytest.t", line 1, characters 0-0:
+  File "tests/filetest.t", line 1, characters 0-0:
   File "tests/myothertest.t/run.t", line 1, characters 0-0:
 
 Passing the name of a test should only run that test.
-Currently, this is not the case.
 
-  $ dune test mytest
-  Error: Don't know about directory mytest specified on the command line!
-  [1]
-  $ dune test mytest.t
-  Error: Don't know about directory mytest.t specified on the command line!
-  [1]
-  $ dune test tests/myothertest
-  Error: Don't know about directory tests/myothertest specified on the command
-  line!
+  $ dune test mytest.t 2>&1 | grep "^File"
+  File "mytest.t", line 1, characters 0-0:
+  $ dune test tests/myothertest.t 2>&1 | grep "^File"
   [1]
-  $ dune test tests/myothertest.t
 
 Passing a directory should run all the tests in that directory (recursively).
 
-The current working directory:
+- The current working directory:
   $ dune test . 2>&1 | grep "^File"
   File "mytest.t", line 1, characters 0-0:
+  File "tests/filetest.t", line 1, characters 0-0:
   File "tests/myothertest.t/run.t", line 1, characters 0-0:
 
-The tests/ subdirectory:
+- The tests/ subdirectory:
   $ dune test tests/ 2>&1 | grep "^File"
+  File "tests/filetest.t", line 1, characters 0-0:
+  File "tests/myothertest.t/run.t", line 1, characters 0-0:
+
+- We can also build in _build/ directories:
+  $ dune test _build/default 2>&1 | grep "^File"
+  File "mytest.t", line 1, characters 0-0:
+  File "tests/filetest.t", line 1, characters 0-0:
   File "tests/myothertest.t/run.t", line 1, characters 0-0:
+  $ dune test _build/default/tests 2>&1 | grep "^File"
+  File "tests/filetest.t", line 1, characters 0-0:
+  File "tests/myothertest.t/run.t", line 1, characters 0-0:
+
+Here we test some error cases a user may encounter and make sure the error
+messages are informative enough.
+
+- Giving a path outside the workspace gives an informative error:
+  $ dune test ..
+  Error: path outside the workspace: .. from .
+  [1]
+- Giving a nonexistent path gives an informative error:
+  $ dune test nonexistent
+  Error: "nonexistent" was not found.
+  [1]
+  $ dune test tests/non
+  Error: "tests/non" was not found.
+  [1]
+- Passing the _build directory on its own is an error.
+  $ dune test _build
+  Error: This path is internal to dune: _build
+  [1]
+- Typos are caught and aided with hints:
+  $ dune test mytest1.t
+  Error: "mytest1.t" was not found.
+  Hint: did you mean mytest.t?
+  [1]