refactor: allow setting workspace root in execution parameters (#8535)

rgrinberg · web-flow · commit df4399bd14e6 · 2023-09-05T18:05:33.000+01:00
Signed-off-by: Rudi Grinberg &lt;me@rgrinberg.com&gt;
diff --git a/src/dune_engine/action_exec.ml b/src/dune_engine/action_exec.ml
@@ -668,15 +668,15 @@ let exec
   and eenv =
     let env =
       match
-        Execution_parameters.add_workspace_root_to_build_path_prefix_map
-          execution_parameters
+        Execution_parameters.workspace_root_to_build_path_prefix_map execution_parameters
       with
-      | false -> env
-      | true ->
+      | Unset -> env
+      | Set target ->
         Dune_util.Build_path_prefix_map.extend_build_path_prefix_map
           env
           `New_rules_have_precedence
-          [ Some { source = Path.to_absolute_filename root; target = "/workspace_root" } ]
+          (* TODO generify *)
+          [ Some { source = Path.to_absolute_filename root; target } ]
     in
     { working_dir = Path.root
     ; env
diff --git a/src/dune_engine/build_system.ml b/src/dune_engine/build_system.ml
@@ -235,7 +235,7 @@ end = struct
 
   (* The current version of the rule digest scheme. We should increment it when
      making any changes to the scheme, to avoid collisions. *)
-  let rule_digest_version = 15
+  let rule_digest_version = 16
 
   let compute_rule_digest
     (rule : Rule.t)
@@ -270,8 +270,8 @@ end = struct
       , List.map locks ~f:Path.to_string
       , Execution_parameters.action_stdout_on_success execution_parameters
       , Execution_parameters.action_stderr_on_success execution_parameters
-      , Execution_parameters.add_workspace_root_to_build_path_prefix_map
-          execution_parameters )
+      , Execution_parameters.workspace_root_to_build_path_prefix_map execution_parameters
+      )
     in
     Digest.generic trace
   ;;
diff --git a/src/dune_engine/execution_parameters.ml b/src/dune_engine/execution_parameters.ml
@@ -27,13 +27,33 @@ module Action_output_limit = struct
   let equal = Int.equal
 end
 
+module Workspace_root_for_build_prefix_map = struct
+  type t =
+    | Unset
+    | Set of string
+
+  let equal x y =
+    match x, y with
+    | Unset, Unset -> true
+    | Unset, _ | _, Unset -> false
+    | Set x, Set y -> String.equal x y
+  ;;
+
+  let to_dyn =
+    let open Dyn in
+    function
+    | Unset -> variant "Unset" []
+    | Set s -> variant "Set" [ string s ]
+  ;;
+end
+
 type t =
   { action_stdout_on_success : Action_output_on_success.t
   ; action_stderr_on_success : Action_output_on_success.t
   ; action_stdout_limit : Action_output_limit.t
   ; action_stderr_limit : Action_output_limit.t
   ; expand_aliases_in_sandbox : bool
-  ; add_workspace_root_to_build_path_prefix_map : bool
+  ; workspace_root_to_build_path_prefix_map : Workspace_root_for_build_prefix_map.t
   ; should_remove_write_permissions_on_generated_files : bool
   }
 
@@ -43,7 +63,7 @@ let equal
   ; action_stdout_limit
   ; action_stderr_limit
   ; expand_aliases_in_sandbox
-  ; add_workspace_root_to_build_path_prefix_map
+  ; workspace_root_to_build_path_prefix_map
   ; should_remove_write_permissions_on_generated_files
   }
   t
@@ -53,9 +73,9 @@ let equal
   && Action_output_limit.equal action_stdout_limit t.action_stdout_limit
   && Action_output_limit.equal action_stderr_limit t.action_stderr_limit
   && Bool.equal expand_aliases_in_sandbox t.expand_aliases_in_sandbox
-  && Bool.equal
-       add_workspace_root_to_build_path_prefix_map
-       t.add_workspace_root_to_build_path_prefix_map
+  && Workspace_root_for_build_prefix_map.equal
+       workspace_root_to_build_path_prefix_map
+       t.workspace_root_to_build_path_prefix_map
   && Bool.equal
        should_remove_write_permissions_on_generated_files
        t.should_remove_write_permissions_on_generated_files
@@ -67,7 +87,7 @@ let hash
   ; action_stdout_limit
   ; action_stderr_limit
   ; expand_aliases_in_sandbox
-  ; add_workspace_root_to_build_path_prefix_map
+  ; workspace_root_to_build_path_prefix_map
   ; should_remove_write_permissions_on_generated_files
   }
   =
@@ -77,7 +97,7 @@ let hash
     , action_stdout_limit
     , action_stderr_limit
     , expand_aliases_in_sandbox
-    , add_workspace_root_to_build_path_prefix_map
+    , workspace_root_to_build_path_prefix_map
     , should_remove_write_permissions_on_generated_files )
 ;;
 
@@ -87,7 +107,7 @@ let to_dyn
   ; action_stdout_limit
   ; action_stderr_limit
   ; expand_aliases_in_sandbox
-  ; add_workspace_root_to_build_path_prefix_map
+  ; workspace_root_to_build_path_prefix_map
   ; should_remove_write_permissions_on_generated_files
   }
   =
@@ -97,8 +117,9 @@ let to_dyn
     ; "action_stdout_limit", Action_output_limit.to_dyn action_stdout_limit
     ; "action_stderr_limit", Action_output_limit.to_dyn action_stderr_limit
     ; "expand_aliases_in_sandbox", Bool expand_aliases_in_sandbox
-    ; ( "add_workspace_root_to_build_path_prefix_map"
-      , Bool add_workspace_root_to_build_path_prefix_map )
+    ; ( "workspace_root_to_build_path_prefix_map"
+      , Workspace_root_for_build_prefix_map.to_dyn workspace_root_to_build_path_prefix_map
+      )
     ; ( "should_remove_write_permissions_on_generated_files"
       , Bool should_remove_write_permissions_on_generated_files )
     ]
@@ -110,7 +131,7 @@ let builtin_default =
   ; action_stdout_limit = Action_output_limit.default
   ; action_stderr_limit = Action_output_limit.default
   ; expand_aliases_in_sandbox = true
-  ; add_workspace_root_to_build_path_prefix_map = true
+  ; workspace_root_to_build_path_prefix_map = Set "/workspace_root"
   ; should_remove_write_permissions_on_generated_files = true
   }
 ;;
@@ -121,20 +142,16 @@ let set_action_stdout_limit x t = { t with action_stdout_limit = x }
 let set_action_stderr_limit x t = { t with action_stderr_limit = x }
 let set_expand_aliases_in_sandbox x t = { t with expand_aliases_in_sandbox = x }
 
-let set_add_workspace_root_to_build_path_prefix_map x t =
-  { t with add_workspace_root_to_build_path_prefix_map = x }
+let set_workspace_root_to_build_path_prefix_map x t =
+  { t with workspace_root_to_build_path_prefix_map = x }
 ;;
 
 let set_should_remove_write_permissions_on_generated_files x t =
   { t with should_remove_write_permissions_on_generated_files = x }
 ;;
 
 let expand_aliases_in_sandbox t = t.expand_aliases_in_sandbox
-
-let add_workspace_root_to_build_path_prefix_map t =
-  t.add_workspace_root_to_build_path_prefix_map
-;;
-
+let workspace_root_to_build_path_prefix_map t = t.workspace_root_to_build_path_prefix_map
 let action_stdout_on_success t = t.action_stdout_on_success
 let action_stderr_on_success t = t.action_stderr_on_success
 let action_stdout_limit t = t.action_stdout_limit
diff --git a/src/dune_engine/execution_parameters.mli b/src/dune_engine/execution_parameters.mli
@@ -49,14 +49,25 @@ end
 
 (** {1 Constructors} *)
 
+(** Set the workspace root directory for the build prefix map, if desired. *)
+module Workspace_root_for_build_prefix_map : sig
+  type t =
+    | Unset (** Do not set the workspace root; only used by external Dune rules *)
+    | Set of string (** [Set root] substitute the root with [root] *)
+end
+
 val builtin_default : t
 val set_action_stdout_on_success : Action_output_on_success.t -> t -> t
 val set_action_stderr_on_success : Action_output_on_success.t -> t -> t
 val set_action_stdout_limit : Action_output_limit.t -> t -> t
 val set_action_stderr_limit : Action_output_limit.t -> t -> t
 val set_expand_aliases_in_sandbox : bool -> t -> t
-val set_add_workspace_root_to_build_path_prefix_map : bool -> t -> t
-val add_workspace_root_to_build_path_prefix_map : t -> bool
+
+val set_workspace_root_to_build_path_prefix_map
+  :  Workspace_root_for_build_prefix_map.t
+  -> t
+  -> t
+
 val set_should_remove_write_permissions_on_generated_files : bool -> t -> t
 
 (** As configured by [init] *)
@@ -70,6 +81,7 @@ val action_stdout_on_success : t -> Action_output_on_success.t
 val action_stderr_on_success : t -> Action_output_on_success.t
 val action_stdout_limit : t -> Action_output_limit.t
 val action_stderr_limit : t -> Action_output_limit.t
+val workspace_root_to_build_path_prefix_map : t -> Workspace_root_for_build_prefix_map.t
 
 (** {1 Initialisation} *)
 
diff --git a/src/dune_rules/dune_project.ml b/src/dune_rules/dune_project.ml
@@ -1079,8 +1079,8 @@ let info t = t.info
 let update_execution_parameters t ep =
   ep
   |> Execution_parameters.set_expand_aliases_in_sandbox t.expand_aliases_in_sandbox
-  |> Execution_parameters.set_add_workspace_root_to_build_path_prefix_map
-       t.map_workspace_root
+  |> Execution_parameters.set_workspace_root_to_build_path_prefix_map
+       (if t.map_workspace_root then Set "/workspace_root" else Unset)
   |> Execution_parameters.set_should_remove_write_permissions_on_generated_files
        (t.dune_version >= (2, 4))
 ;;
diff --git a/test/blackbox-tests/test-cases/dune-cache/mode-copy.t b/test/blackbox-tests/test-cases/dune-cache/mode-copy.t
@@ -40,9 +40,9 @@ never built [target1] before.
   $ dune build --config-file=config target1 --debug-cache=shared,workspace-local \
   >   2>&1 | grep '_build/default/source\|_build/default/target'
   Workspace-local cache miss: _build/default/source: never seen this target before
-  Shared cache miss [a0435a82f38c0cb32e265a22d1f9e08c] (_build/default/source): not found in cache
+  Shared cache miss [9acd3a08d49c004c7c4af47984604b5c] (_build/default/source): not found in cache
   Workspace-local cache miss: _build/default/target1: never seen this target before
-  Shared cache miss [25faf482a530be4a0e4efbd8e38411f5] (_build/default/target1): not found in cache
+  Shared cache miss [c8ba5d0ce97e5b84d90b24999e54d106] (_build/default/target1): not found in cache
 
   $ dune_cmd stat hardlinks _build/default/source
   1
diff --git a/test/blackbox-tests/test-cases/dune-cache/mode-hardlink.t b/test/blackbox-tests/test-cases/dune-cache/mode-hardlink.t
@@ -35,9 +35,9 @@ never built [target1] before.
   $ dune build --config-file=config target1 --debug-cache=shared,workspace-local \
   >   2>&1 | grep '_build/default/source\|_build/default/target'
   Workspace-local cache miss: _build/default/source: never seen this target before
-  Shared cache miss [b134f8385a83866193d82617babc213e] (_build/default/source): not found in cache
+  Shared cache miss [4971137801799003aa6e088963677239] (_build/default/source): not found in cache
   Workspace-local cache miss: _build/default/target1: never seen this target before
-  Shared cache miss [bd1e628609440e4bf23adfd96baa7548] (_build/default/target1): not found in cache
+  Shared cache miss [967c475fcb42c969b0a32a612f7f8918] (_build/default/target1): not found in cache
 
   $ dune_cmd stat hardlinks _build/default/source
   3
diff --git a/test/blackbox-tests/test-cases/dune-cache/repro-check.t b/test/blackbox-tests/test-cases/dune-cache/repro-check.t
@@ -67,7 +67,7 @@ Set 'cache-check-probability' to 1.0, which should trigger the check
   > EOF
   $ rm -rf _build
   $ dune build --config-file config reproducible non-reproducible
-  Warning: cache store error [a37871748f60d220bd4536190e1620c4]: ((in_cache
+  Warning: cache store error [9c0ced5efcd85d0a6c5364bee242c3a2]: ((in_cache
   ((non-reproducible 1c8fc4744d4cef1bd2b8f5e915b36be9))) (computed
   ((non-reproducible 6cfaa7a90747882bcf4ffe7252c1cf89)))) after executing
   (echo 'build non-reproducible';cp dep non-reproducible)
@@ -119,7 +119,7 @@ Test that the environment variable and the command line flag work too
 
   $ rm -rf _build
   $ DUNE_CACHE_CHECK_PROBABILITY=1.0 dune build --cache=enabled reproducible non-reproducible
-  Warning: cache store error [a37871748f60d220bd4536190e1620c4]: ((in_cache
+  Warning: cache store error [9c0ced5efcd85d0a6c5364bee242c3a2]: ((in_cache
   ((non-reproducible 1c8fc4744d4cef1bd2b8f5e915b36be9))) (computed
   ((non-reproducible 6cfaa7a90747882bcf4ffe7252c1cf89)))) after executing
   (echo 'build non-reproducible';cp dep non-reproducible)
@@ -131,7 +131,7 @@ Test that the environment variable and the command line flag work too
 
   $ rm -rf _build
   $ dune build --cache=enabled --cache-check-probability=1.0 reproducible non-reproducible
-  Warning: cache store error [a37871748f60d220bd4536190e1620c4]: ((in_cache
+  Warning: cache store error [9c0ced5efcd85d0a6c5364bee242c3a2]: ((in_cache
   ((non-reproducible 1c8fc4744d4cef1bd2b8f5e915b36be9))) (computed
   ((non-reproducible 6cfaa7a90747882bcf4ffe7252c1cf89)))) after executing
   (echo 'build non-reproducible';cp dep non-reproducible)
diff --git a/test/blackbox-tests/test-cases/dune-cache/trim.t b/test/blackbox-tests/test-cases/dune-cache/trim.t
@@ -78,8 +78,8 @@ entries uniformly.
 
   $ (cd "$PWD/.xdg-cache/dune/db/meta/v5"; grep -rws . -e 'metadata' | sort ) > out
   $ cat out
-  ./00/005056244c2ed30e70b9cafe3a820bbe:((8:metadata)(5:files(8:target_a32:5637dd9730e430c7477f52d46de3909c)))
-  ./93/931ec90aa8ac4a33a5af177649ff8b71:((8:metadata)(5:files(8:target_b32:8a53bfae3829b48866079fa7f2d97781)))
+  ./25/259be1c0c7a2f2eab4f17969ff8486f5:((8:metadata)(5:files(8:target_a32:5637dd9730e430c7477f52d46de3909c)))
+  ./f2/f280f0a3c487ec316e741894b164691a:((8:metadata)(5:files(8:target_b32:8a53bfae3829b48866079fa7f2d97781)))
 
   $ digest="$(awk -F: '/target_b/ { digest=$1 } END { print digest }' < out)"
 
