fix: dune test dirtest.t/run.t running cram test incorrectly

We fix an issue where a user can write

```
dune test dirtest.t/run.t
```

and the corresponding cram test was being run incorrectly. This was due
to the buggy parent detection code in runtest.ml. We fix how the parent
directory of a cram test is actually detected and do some cleanup for
cram source related code.

The runtest.ml test is updated to better reflect what we expect the
command to do.

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

Author: Alizter

bin/runtest.ml

@@ -33,6 +33,20 @@ let runtest_info =
 ;;
 
 let find_cram_test path ~parent_dir =
+  (* We correct the [path] and [parent_dir] if we have a directory test and the
+     user has given a path to "run.t" rather than the directory cram test itself. *)
+  let path, parent_dir =
+    Option.value ~default:(path, parent_dir)
+    @@
+    let open Option.O in
+    let* basename = Path.Source.basename_opt path in
+    if String.equal basename Source.Cram_test.fname_in_dir_test
+    then
+      let* parent_dir_of_run = Path.Source.parent path in
+      let+ parent_dir = Path.Source.parent parent_dir_of_run in
+      parent_dir_of_run, parent_dir
+    else None
+  in
   let open Memo.O in
   Source_tree.nearest_dir parent_dir
   >>= Dune_rules.Cram_rules.cram_tests
@@ -42,13 +56,11 @@ let find_cram_test path ~parent_dir =
   >>| 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 : Source.Cram_test.t) ->
-    let src =
-      match test with
-      | File src -> src
-      | Dir { dir = src; _ } -> src
-    in
-    Path.Source.equal path src)
+  >>| List.find_map ~f:(fun (test : Source.Cram_test.t) ->
+    let open Option.O in
+    let* cram_basename = Source.Cram_test.path test |> Path.Source.basename_opt in
+    let* basename = Path.Source.basename_opt path in
+    Option.some_if (Filename.equal cram_basename basename) (test, parent_dir))
 ;;
 
 let explain_unsuccessful_search path ~parent_dir =
@@ -92,7 +104,7 @@ let disambiguate_test_name path =
     let open Memo.O in
     find_cram_test path ~parent_dir
     >>= (function
-     | Some test ->
+     | Some (test, parent_dir) ->
        (* If we find the cram test, then we request that is run. *)
        Memo.return (`Test (parent_dir, Source.Cram_test.name test))
      | None ->

src/source/cram_test.ml

@@ -7,9 +7,11 @@ type t =
       ; dir : Path.Source.t
       }
 
-let is_cram_suffix = String.is_suffix ~suffix:".t"
+let fname_in_dir_test = "run.t"
+let suffix = ".t"
+let is_cram_suffix = String.is_suffix ~suffix
 
-let dyn_of_t =
+let to_dyn =
   let open Dyn in
   function
   | File f -> variant "File" [ Path.Source.to_dyn f ]
@@ -19,19 +21,17 @@ let dyn_of_t =
       [ record [ "file", Path.Source.to_dyn file; "dir", Path.Source.to_dyn dir ] ]
 ;;
 
+let path = function
+  | File file -> file
+  | Dir d -> d.dir
+;;
+
 let name t =
-  String.drop_suffix
-    ~suffix:".t"
-    (match t with
-     | File file -> Path.Source.basename file
-     | Dir { file = _; dir } -> Path.Source.basename dir)
-  |> Option.value_exn
+  path t |> Path.Source.basename |> String.drop_suffix ~suffix |> Option.value_exn
 ;;
 
 let script t =
   match t with
   | File f -> f
   | Dir d -> d.file
 ;;
-
-let fname_in_dir_test = "run.t"

src/source/cram_test.mli

@@ -1,14 +1,31 @@
 open Import
 
+(** [t] represents the source file associated to a cram test. *)
 type t =
   | File of Path.Source.t
   | Dir of
       { file : Path.Source.t
       ; dir : Path.Source.t
       }
 
-val is_cram_suffix : string -> bool
-val dyn_of_t : t -> Dyn.t
-val name : t -> string
+val to_dyn : t -> Dyn.t
+
+(** Checks if a filename has the ".t" suffix for a cram test. *)
+val is_cram_suffix : Filename.t -> bool
+
+(** The "run.t" filename for directory cram tests. *)
 val fname_in_dir_test : Filename.t
+
+(** The [name] of a cram test. If this is a file test, then it will be the file
+    name without the cram suffix. If this is a directory test, then it will be
+    the directory name without the cram suffix. *)
+val name : t -> string
+
+(** The [path] associated to a cram test. If this is a file test, then it will
+    be the file. If this is a directory test, then it will be the directory. *)
+val path : t -> Path.Source.t
+
+(** The [script] of a cram test. If this is a file test, then it will be the
+    file. If this is a directory test, then it will be the "run.t" file inside
+    that directory. *)
 val script : t -> Path.Source.t

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

@@ -6,54 +6,50 @@ Here we test the features of the `dune runtest` command.
 
   $ cat > mytest.t <<EOF
   >   $ echo "Hello, world!"
-  > "Goodbye, world!"
+  >   "Goodbye, world!"
   > EOF
   $ mkdir -p tests/myothertest.t
   $ echo 'Hello, world!' > tests/myothertest.t/hello.world
   $ cat > tests/myothertest.t/run.t <<EOF
   >   $ cat hello.world
-  > "Goodbye, world!"
+  >   "Goodbye, world!"
   > EOF
   $ cat > tests/filetest.t <<EOF
   >   $ echo "Hello, world!"
-  > "Goodbye, world!"
+  >   "Goodbye, world!"
   > EOF
 
-
 This should work:
 
   $ dune test tests/myothertest.t
   File "tests/myothertest.t/run.t", line 1, characters 0-0:
   Error: Files _build/default/tests/myothertest.t/run.t and
   _build/default/tests/myothertest.t/run.t.corrected differ.
   [1]
-
-There's no diff produced because the test passes
-
   $ dune promotion diff tests/myothertest.t/run.t
 
-This should not work
-
-  $ dune test myotherttest.t
-  Error: "myotherttest.t" does not match any known test.
-  [1]
+We use the promotion diff to make sure that a promotion is being registered. If
+there is no promotion it will warn.
 
-This is a bug. Running the test this way does not correctly include the
-dependencies.
+If the user writes the run.t file of a directory test, we should correct it to
+be the corresponding directory cram test.
 
   $ dune test tests/myothertest.t/run.t
   File "tests/myothertest.t/run.t", line 1, characters 0-0:
   Error: Files _build/default/tests/myothertest.t/run.t and
   _build/default/tests/myothertest.t/run.t.corrected differ.
   [1]
-
   $ dune promotion diff tests/myothertest.t/run.t
 
-  $ cat _build/.promotion-staging/tests/myothertest.t/run.t
-    $ cat hello.world
-    cat: hello.world: No such file or directory
-    [1]
-  "Goodbye, world!"
+We cannot give the name of a cram test in a subdirectory and expect Dune to
+find it.
+
+  $ dune test myothertest.t
+  Error: "myothertest.t" does not match any known test.
+  [1]
+
+  $ dune promotion diff tests/myothertest.t/run.t
+  Warning: Nothing to promote for tests/myothertest.t/run.t.
 
 Passing no arguments to $ dune runtest should be equivalent to $ dune build
 @runtest.
@@ -128,7 +124,7 @@ messages are informative enough.
   Error: "testt" does not match any known test.
   Hint: did you mean tests?
   [1]
-- Note that this doesn't handle the case where the path is mostly correct but
+- Note that this does not handle the case where the path is mostly correct but
 the directory is mispelled.
   $ dune test testss/myothertest.t
   Error: "testss/myothertest.t" does not match any known test.