fix(engine): directory targets sanity check

The current sanity check for directory targets does not take into
account rule redirection. This commit fixes the check to account for all
generated subdirectories and improves the error message.

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

ps-id: E2A4355D-89E1-4A92-92F7-918981AAB107

src/dune_engine/build_config.mli

@@ -26,7 +26,10 @@ type rules =
         (** Directories that are target of a rule. For each directory target,
             give the location of the rule that generates it. The keys in this
             map must correspond exactly to the set of directory targets that
-            will be produces by [rules]. *)
+            will be produces by [rules]. The values should be the locations of
+            the rules that are going to produce these targets. However, it's ok
+            to have an approximate location as the rule that produces the target
+            will be responsible for producing the final location*)
   ; rules : Rules.t Memo.t
   }
 

src/dune_engine/load_rules.ml

@@ -630,6 +630,37 @@ end = struct
             && Subdir_set.mem build_dir_only_sub_dirs name
           then report_rule_internal_dir_conflict name loc);
       let* rules_produced = Memo.Lazy.force rules in
+      let () =
+        let real_directory_targets = Rules.directory_targets rules_produced in
+        if
+          not
+            (Path.Build.Map.equal real_directory_targets directory_targets
+               ~equal:(fun _ _ ->
+                 (* The locations should match if the declration knows which
+                    rule will generate the directory, but it it's not necessary
+                    as the rule's actual location has higher priority. *)
+                 true))
+        then
+          let mismatched_directories =
+            let error message loc =
+              Dyn.record
+                [ ("message", Dyn.string message); ("loc", Loc.to_dyn_hum loc) ]
+            in
+            Path.Build.Map.merge real_directory_targets directory_targets
+              ~f:(fun _ generated declared ->
+                match (generated, declared) with
+                | None, None | Some _, Some _ -> None
+                | Some loc, None -> Some (error "not declared" loc)
+                | None, Some loc -> Some (error "not generated" loc))
+          in
+          Code_error.raise
+            "gen_rules returned a set of directory targets that doesn't match \
+             the set of directory targets from returned rules"
+            [ ("dir", Path.Build.to_dyn dir)
+            ; ( "mismatched_directories"
+              , Path.Build.Map.to_dyn Fun.id mismatched_directories )
+            ]
+      in
       let rules =
         let dir = Path.build dir in
         Rules.find rules_produced dir
@@ -782,20 +813,6 @@ end = struct
       in
       let subdirs_to_keep = Subdir_set.of_dir_set descendants_to_keep in
       let rules_here = compile_rules ~dir ~source_dirs rules in
-      let real_directory_targets =
-        Path.Build.Set.of_keys rules_here.by_directory_targets
-      in
-      let directory_targets = Path.Build.Set.of_keys directory_targets in
-      if not (Path.Build.Set.equal directory_targets real_directory_targets)
-      then
-        Code_error.raise
-          "gen_rules returned a set of directory targets that doesn't match \
-           the set of directory targets from returned rules"
-          [ ("dir", Path.Build.to_dyn dir)
-          ; ("directory_targets", Path.Build.Set.to_dyn directory_targets)
-          ; ( "real_directory_targets"
-            , Path.Build.Set.to_dyn real_directory_targets )
-          ];
       remove_old_artifacts ~dir ~rules_here ~subdirs_to_keep;
       remove_old_sub_dirs_in_anonymous_actions_dir
         ~dir:

src/dune_engine/rules.ml

@@ -184,6 +184,18 @@ let of_rules rules =
         | None -> Some (Dir_rules.Nonempty.singleton (Rule rule))
         | Some acc -> Some (Dir_rules.Nonempty.add acc (Rule rule))))
 
+let directory_targets (rules : t) =
+  Path.Build.Map.fold ~init:Path.Build.Map.empty rules
+    ~f:(fun (dir_rules : Dir_rules.Nonempty.t) acc ->
+      (dir_rules :> Dir_rules.t)
+      |> Id.Map.fold ~init:acc ~f:(fun (data : Dir_rules.data) acc ->
+             match data with
+             | Alias _ -> acc
+             | Rule rule ->
+               Path.Build.Set.fold ~init:acc rule.targets.dirs
+                 ~f:(fun target acc ->
+                   Path.Build.Map.add_exn acc target rule.loc)))
+
 let collect f =
   let open Memo.O in
   let+ result, out = Memo.Implicit_output.collect implicit_output f in

src/dune_engine/rules.mli

@@ -115,3 +115,7 @@ val find : t -> Path.t -> Dir_rules.t
 
 (** [prefix_rules prefix ~f] adds [prefix] to all the rules generated by [f] *)
 val prefix_rules : unit Action_builder.t -> f:(unit -> 'a Memo.t) -> 'a Memo.t
+
+(** [directory_targets t] returns all the directory tagets generated by [t]. The
+    locations are of the rules that introduce these targets *)
+val directory_targets : t -> Loc.t Path.Build.Map.t