test: include_subdirs unqualified duplicates cram rules (#12142)

* test: include_subdirs unqualified and directory cram test

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

* fix: cram tests with (inlude_subdirs ..)

Pass the source directory of each directory contents.

Otherwise, we end up generating rules for one dir more than once.

Signed-off-by: Rudi Grinberg <[email protected]>

* test(cram): update test documentation

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

---------

Signed-off-by: Ali Caglayan <[email protected]>
Signed-off-by: Rudi Grinberg <[email protected]>
Co-authored-by: Rudi Grinberg <[email protected]>

Author: Alizter

src/dune_rules/coq/coq_sources.ml

@@ -28,11 +28,13 @@ let empty =
 ;;
 
 let coq_modules_of_files ~dirs =
-  let filter_v_files ({ Source_file_dir.dir = _; path_to_root = _; files } as sd) =
+  let filter_v_files
+        ({ Source_file_dir.dir = _; path_to_root = _; files; source_dir = _ } as sd)
+    =
     { sd with files = String.Set.filter files ~f:(fun f -> Filename.check_suffix f ".v") }
   in
   let dirs = List.map dirs ~f:filter_v_files in
-  let build_mod_dir { Source_file_dir.dir; path_to_root = prefix; files } =
+  let build_mod_dir { Source_file_dir.dir; path_to_root = prefix; files; source_dir = _ } =
     String.Set.to_list_map files ~f:(fun file ->
       let name, _ = Filename.split_extension file in
       let name = Coq_module.Name.make name in

src/dune_rules/dir_contents.ml

@@ -25,16 +25,18 @@ type t =
   ; mlds : (Documentation.t * Doc_sources.mld list) list Memo.Lazy.t
   ; coq : Coq_sources.t Memo.Lazy.t
   ; ml : Ml_sources.t Memo.Lazy.t
+  ; source_dir : Source_tree.Dir.t option
   }
 
 and kind =
   | Standalone
   | Group_root of t list
   | Group_part
 
-let empty kind ~dir =
+let empty kind ~dir ~source_dir =
   { kind
   ; dir
+  ; source_dir
   ; text_files = Filename.Set.empty
   ; ml = Memo.Lazy.of_val Ml_sources.empty
   ; mlds = Memo.Lazy.of_val []
@@ -52,11 +54,11 @@ module Standalone_or_root = struct
 
   type nonrec t = { contents : standalone_or_root Memo.Lazy.t }
 
-  let empty ~dir =
+  let empty ~dir ~source_dir =
     { contents =
         Memo.Lazy.create (fun () ->
           Memo.return
-            { root = empty Standalone ~dir
+            { root = empty Standalone ~dir ~source_dir
             ; rules = Rules.empty
             ; subdirs = Path.Build.Map.empty
             })
@@ -84,6 +86,7 @@ type triage =
   | Group_part of Path.Build.t
 
 let dir t = t.dir
+let source_dir t = t.source_dir
 let coq t = Memo.Lazy.force t.coq
 let ocaml t = Memo.Lazy.force t.ml
 
@@ -235,7 +238,10 @@ end = struct
               let src_dir = Dune_file.dir d in
               stanzas >>= load_text_files sctx st_dir ~src_dir ~dir)
           in
-          let dirs = [ { Source_file_dir.dir; path_to_root = []; files } ] in
+          let dirs =
+            [ { Source_file_dir.dir; path_to_root = []; files; source_dir = Some st_dir }
+            ]
+          in
           let ml =
             Memo.lazy_ (fun () ->
               let lookup_vlib = lookup_vlib sctx ~current_dir:dir in
@@ -257,6 +263,7 @@ end = struct
           let mlds = mlds ~sctx ~dir ~dune_file:d ~files in
           { Standalone_or_root.root =
               { kind = Standalone
+              ; source_dir = Some st_dir
               ; dir
               ; text_files = files
               ; ml
@@ -315,9 +322,20 @@ end = struct
                             ~src_dir:(Source_tree.Dir.path source_dir)
                             ~dir
                         in
-                        { Source_file_dir.dir; path_to_root = path_to_group_root; files })))
+                        { Source_file_dir.dir
+                        ; path_to_root = path_to_group_root
+                        ; files
+                        ; source_dir = Some source_dir
+                        })))
+           in
+           let dirs =
+             { Source_file_dir.dir
+             ; path_to_root = []
+             ; files
+             ; source_dir = Some source_dir
+             }
+             :: subdirs
            in
-           let dirs = { Source_file_dir.dir; path_to_root = []; files } :: subdirs in
            let lib_config =
              let+ ocaml = Context.ocaml ctx in
              ocaml.lib_config
@@ -350,18 +368,22 @@ end = struct
            in
            let mlds = mlds ~sctx ~dir ~dune_file ~files in
            let subdirs =
-             List.map subdirs ~f:(fun { Source_file_dir.dir; path_to_root = _; files } ->
-               { kind = Group_part
-               ; dir
-               ; text_files = files
-               ; ml
-               ; foreign_sources
-               ; mlds
-               ; coq
-               })
+             List.map
+               subdirs
+               ~f:(fun { Source_file_dir.dir; path_to_root = _; files; source_dir } ->
+                 { kind = Group_part
+                 ; source_dir
+                 ; dir
+                 ; text_files = files
+                 ; ml
+                 ; foreign_sources
+                 ; mlds
+                 ; coq
+                 })
            in
            let root =
              { kind = Group_root subdirs
+             ; source_dir = Some source_dir
              ; dir
              ; text_files = files
              ; ml
@@ -383,8 +405,11 @@ end = struct
     >>= function
     | Is_component_of_a_group_but_not_the_root { group_root; stanzas = _ } ->
       Memo.return @@ Group_part group_root
-    | Lock_dir | Generated | Source_only _ ->
-      Memo.return @@ Standalone_or_root (Standalone_or_root.empty ~dir)
+    | Generated ->
+      Memo.return @@ Standalone_or_root (Standalone_or_root.empty ~dir ~source_dir:None)
+    | Lock_dir source_dir | Source_only source_dir ->
+      Memo.return
+      @@ Standalone_or_root (Standalone_or_root.empty ~dir ~source_dir:(Some source_dir))
     | Standalone (st_dir, d) ->
       Memo.return @@ Standalone_or_root (make_standalone sctx st_dir ~dir d)
     | Group_root root ->

src/dune_rules/dir_contents.mli

@@ -12,6 +12,7 @@ open Import
 type t
 
 val dir : t -> Path.Build.t
+val source_dir : t -> Source_tree.Dir.t option
 
 (** Files in this directory. At the moment, this doesn't include all generated
     files, just the ones generated by [rule], [ocamllex], [ocamlyacc], [menhir]

src/dune_rules/dir_status.ml

@@ -28,7 +28,7 @@ end
 
 module T = struct
   type t =
-    | Lock_dir
+    | Lock_dir of Source_tree.Dir.t
     | Generated
     | Source_only of Source_tree.Dir.t
     | (* Directory not part of a multi-directory group *)
@@ -47,7 +47,7 @@ type enclosing_group =
   | Group_root of Path.Build.t
 
 let current_group dir = function
-  | Lock_dir | Generated | Source_only _ | Standalone _ -> No_group
+  | Lock_dir _ | Generated | Source_only _ | Standalone _ -> No_group
   | Group_root _ -> Group_root dir
   | Is_component_of_a_group_but_not_the_root { group_root; _ } -> Group_root group_root
 ;;
@@ -230,7 +230,7 @@ end = struct
     let rec walk st_dir ~dir ~local =
       DB.get ~dir
       >>= function
-      | Lock_dir | Generated | Source_only _ | Standalone _ | Group_root _ ->
+      | Lock_dir _ | Generated | Source_only _ | Standalone _ | Group_root _ ->
         Memo.return Appendable_list.empty
       | Is_component_of_a_group_but_not_the_root { stanzas; group_root = _ } ->
         let* stanzas =
@@ -323,7 +323,7 @@ end = struct
        | None -> false
        | Some of_ -> Path.Source.is_descendant ~of_ src_dir)
       >>= (function
-       | true -> Memo.return Lock_dir
+       | true -> Memo.return (Lock_dir st_dir)
        | false ->
          let build_dir_is_project_root = build_dir_is_project_root st_dir in
          Dune_load.stanzas_in_dir dir
@@ -348,7 +348,7 @@ end
 
 let directory_targets t ~jsoo_enabled ~dir =
   match t with
-  | Lock_dir | Generated | Source_only _ | Is_component_of_a_group_but_not_the_root _ ->
+  | Lock_dir _ | Generated | Source_only _ | Is_component_of_a_group_but_not_the_root _ ->
     Memo.return Path.Build.Map.empty
   | Standalone (_, dune_file) ->
     Dune_file.stanzas dune_file >>= extract_directory_targets ~jsoo_enabled ~dir

src/dune_rules/dir_status.mli

@@ -26,7 +26,8 @@ module Group_root : sig
 end
 
 type t =
-  | Lock_dir
+  | Lock_dir of
+      Source_tree.Dir.t (* XXX Will have to be modified once lock dirs are targets *)
   | Generated
   | Source_only of Source_tree.Dir.t
   | Standalone of Source_tree.Dir.t * Dune_file.t

src/dune_rules/foreign_sources.ml

@@ -98,7 +98,7 @@ module Unresolved = struct
     List.fold_left
       dirs
       ~init:String.Map.empty
-      ~f:(fun acc { Source_file_dir.dir; path_to_root = _; files } ->
+      ~f:(fun acc { Source_file_dir.dir; path_to_root = _; files; source_dir = _ } ->
         let sources = load ~dir ~dune_version ~files in
         String.Map.Multi.rev_union sources acc)
   ;;

src/dune_rules/gen_rules.ml

@@ -477,6 +477,7 @@ let gen_rules_standalone_or_root sctx ~dir ~source_dir =
       let* cctxs = gen_rules_group_part_or_root sctx dir_contents [] ~source_dir ~dir in
       Dir_contents.Standalone_or_root.subdirs standalone_or_root
       >>= Memo.parallel_iter ~f:(fun dc ->
+        let source_dir = Option.value_exn (Dir_contents.source_dir dc) in
         let+ (_ : (Loc.t * Compilation_context.t) list) =
           gen_rules_group_part_or_root
             sctx
@@ -506,7 +507,7 @@ let gen_automatic_subdir_rules sctx ~dir ~nearest_src_dir ~src_dir =
 let gen_rules_regular_directory (sctx : Super_context.t Memo.t) ~src_dir ~components ~dir =
   Dir_status.DB.get ~dir
   >>= function
-  | Lock_dir -> Memo.return Gen_rules.no_rules
+  | Lock_dir _ -> Memo.return Gen_rules.no_rules
   | dir_status ->
     let+ rules =
       let* st_dir = Source_tree.find_dir src_dir in
@@ -550,7 +551,7 @@ let gen_rules_regular_directory (sctx : Super_context.t Memo.t) ~src_dir ~compon
             Gen_rules.rules_for ~dir ~directory_targets ~allowed_subdirs rules
         in
         match dir_status with
-        | Lock_dir -> Gen_rules.rules_here Gen_rules.Rules.empty
+        | Lock_dir _ -> Gen_rules.rules_here Gen_rules.Rules.empty
         | Source_only source_dir ->
           gen_rules_source_only sctx ~dir source_dir |> make_rules |> Gen_rules.rules_here
         | Generated | Is_component_of_a_group_but_not_the_root _ ->

src/dune_rules/ml_sources.ml

@@ -575,7 +575,7 @@ let make
         List.fold_left
           dirs
           ~init:Module_trie.empty
-          ~f:(fun acc { Source_file_dir.dir; path_to_root; files } ->
+          ~f:(fun acc { Source_file_dir.dir; path_to_root; files; source_dir = _ } ->
             match
               let path =
                 let loc =
@@ -620,7 +620,7 @@ let make
         List.fold_left
           dirs
           ~init:Module_name.Map.empty
-          ~f:(fun acc { Source_file_dir.dir; files; path_to_root = _ } ->
+          ~f:(fun acc { Source_file_dir.dir; files; path_to_root = _; source_dir = _ } ->
             let modules = modules_of_files ~dialects ~dir ~files ~path:[] in
             Module_name.Map.union acc modules ~f:(fun name x y ->
               User_error.raise

src/dune_rules/source_file_dir.ml

@@ -4,4 +4,5 @@ type t =
   { dir : Path.Build.t
   ; path_to_root : Filename.t list
   ; files : Filename.Set.t
+  ; source_dir : Source_tree.Dir.t option
   }

src/dune_rules/source_file_dir.mli

@@ -4,4 +4,5 @@ type t =
   { dir : Path.Build.t
   ; path_to_root : Filename.t list
   ; files : Filename.Set.t
+  ; source_dir : Source_tree.Dir.t option
   }