Merge pull request ocaml#11869 from Alizter/fix-foo_t_run_t

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

Author: Alizter

bin/runtest.ml

@@ -35,21 +35,20 @@ let runtest_info =
 
 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 : Source.Cram_test.t) ->
-    let src =
-      match test with
-      | File src -> src
-      | Dir { dir = src; _ } -> src
-    in
-    Path.Source.equal path src)
+  Source_tree.find_dir parent_dir
+  >>= function
+  | None -> Memo.return None
+  | Some dir ->
+    Dune_rules.Cram_rules.cram_tests dir
+    >>| List.find_map ~f:(function
+      | Ok cram_test when Path.Source.equal path (Source.Cram_test.path cram_test) ->
+        Some cram_test
+      (* We raise any error we encounter when looking for our test specifically. *)
+      | Error (Dune_rules.Cram_rules.Missing_run_t cram_test)
+        when Path.Source.equal path (Source.Cram_test.path cram_test) ->
+        Dune_rules.Cram_rules.missing_run_t cram_test
+      (* Any errors or successes unrelated to our test are discarded. *)
+      | Error (Dune_rules.Cram_rules.Missing_run_t _) | Ok _ -> None)
 ;;
 
 let explain_unsuccessful_search path ~parent_dir =
@@ -95,7 +94,7 @@ let disambiguate_test_name path =
     >>= (function
      | Some test ->
        (* If we find the cram test, then we request that is run. *)
-       Memo.return (`Test (parent_dir, Source.Cram_test.name test))
+       Memo.return (`Cram (parent_dir, test))
      | None ->
        (* If we don't find it, then we assume the user intended a directory for
           @runtest to be used. *)
@@ -140,7 +139,8 @@ let runtest_term =
       Alias.request
       @@
       match alias_kind with
-      | `Test (dir, alias_name) ->
+      | `Cram (dir, cram) ->
+        let alias_name = Source.Cram_test.name cram in
         Alias.in_dir
           ~name:(Dune_engine.Alias.Name.of_string alias_name)
           ~recursive:false

src/dune_rules/cram/cram_rules.ml

@@ -31,23 +31,19 @@ end
 type error = Missing_run_t of Cram_test.t
 
 let missing_run_t (error : Cram_test.t) =
-  Action_builder.fail
-    { fail =
-        (fun () ->
-          let dir =
-            match error with
-            | File _ ->
-              (* This error is impossible for file tests *)
-              assert false
-            | Dir { dir; file = _ } -> dir
-          in
-          User_error.raise
-            ~loc:(Loc.in_dir (Path.source dir))
-            [ Pp.textf
-                "Cram test directory %s does not contain a run.t file."
-                (Path.Source.to_string dir)
-            ])
-    }
+  let dir =
+    match error with
+    | File _ ->
+      (* This error is impossible for file tests *)
+      assert false
+    | Dir { dir; file = _ } -> dir
+  in
+  User_error.raise
+    ~loc:(Loc.in_dir (Path.source dir))
+    [ Pp.textf
+        "Cram test directory %s does not contain a run.t file."
+        (Path.Source.to_string dir)
+    ]
 ;;
 
 let test_rule
@@ -81,7 +77,8 @@ let test_rule
   match test with
   | Error (Missing_run_t test) ->
     (* We error out on invalid tests even if they are disabled. *)
-    Alias_rules.add sctx ~alias ~loc (missing_run_t test)
+    Action_builder.fail { fail = (fun () -> missing_run_t test) }
+    |> Alias_rules.add sctx ~alias ~loc
   | Ok test ->
     (* Morally, this is equivalent to evaluating them all concurrently and
        taking the conjunction, but we do it this way to avoid evaluating things

src/dune_rules/cram/cram_rules.mli

@@ -3,7 +3,11 @@
 open Import
 
 (** The type of errors that can occur when searching for cram tests *)
-type error
+type error = Missing_run_t of Cram_test.t
+
+(** [missing_run_t cram_test] raises an error message explaining that the
+    directory test [cram_test] is missing it's [run.t]. *)
+val missing_run_t : Cram_test.t -> 'a
 
 (** Memoized list of cram tests in a directory. *)
 val cram_tests : Source_tree.Dir.t -> (Cram_test.t, error) result list Memo.t

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/cram/kinds.t

@@ -64,6 +64,10 @@ If there is no run.t file, an error message is displayed.
   File "dir-no-run/dir.t", line 1, characters 0-0:
   Error: Cram test directory dir-no-run/dir.t does not contain a run.t file.
   [1]
+  $ dune runtest dir-no-run/dir.t
+  File "dir-no-run/dir.t", line 1, characters 0-0:
+  Error: Cram test directory dir-no-run/dir.t does not contain a run.t file.
+  [1]
 
 However, if the directory is empty, this check is skipped. (git can leave such
 empty directories)

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

@@ -6,54 +6,52 @@ 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 runtest should be able to run a specfic test. In this case,
+tests/myothertest.t should fail because the expected output is different from
+the observed output.
 
   $ 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 is 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 command to check there is a promotion pending. 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.
@@ -161,7 +159,7 @@ the directory is mispelled.
   Error: This path is outside the workspace: /a/b/c/
   [1]
 
-Here we test behavour for running tests in specific contexts.
+Here we test behaviour for running tests in specific contexts.
 
   $ cat > dune-workspace <<EOF
   > (lang dune 3.20)