Add dune-project stanza, map_workspace_root, to control workspace map…

…ping. Add a "map_workspace_root" stanza to the dune-project file. If true, references to the workspace root directory in output files are mapped to "/workspace_root". If false, such references are not modified. If missing, it defaults to true. Note that in the added tests, for some configurations quotes are needed around the "EOF" delimeter to get expansion. Note also that when enabled, the debug search directories in the debug information produced by ocamlc are also mapped, with the result that ocamldebug cannot find the files. Fixes ocaml#6929, provided user disables mapping. Signed-off-by: Richard L Ford <richardlford@gmail.com> Co-authored-by: Christine Rose <christinerose@users.noreply.github.com> Co-authored-by: Etienne Millon <etienne.millon@gmail.com> Co-authored-by: Ali Caglayan <alizter@gmail.com>
richardlford · Feb 9, 2023 · e70649b · e70649b
1 parent 50eda63
commit e70649b
Show file tree

Hide file tree

Showing 8 changed files with 113 additions and 3 deletions.
diff --git a/CHANGES.md b/CHANGES.md
@@ -1,5 +1,10 @@
 Unreleased
 ----------
+
+- Add map_workspace_root dune-project stanza to allow disabling of
+  mapping of workspace root to /workspace_root. (#6988, fixes #6929,
+  @richardlford)
+
 - Fix handling of support files generated by odoc. (#6913, @jonludlam)
 
 - Fix parsing of OCaml errors that contain code excerpts with `...` in them.

diff --git a/doc/dune-files.rst b/doc/dune-files.rst
@@ -437,6 +437,30 @@ Starting with Dune 2.0, Dune mangles compilation units of executables by
 default. However, this can still be turned off using ``(wrapped_executables
 false)``
 
+.. _map-workspace-root:
+
+map_workspace_root
+-------------------
+
+.. versionadded:: 3.7
+
+The desirable output of tools will not contain references to the
+file system location from which they were built. Starting from Dune 3.0,
+Dune has mapped references to the workspace directory to "/workspace_root".
+
+An option is available to turn on/off mapping
+of the workspace on a per-project basis:
+
+.. code:: scheme
+
+    (map_workspace_root <bool>)
+
+This can be turned off using 
+``(map_workspace_root false)``
+Note that when this mapping is enabled, the debug information produced
+by the bytecode compiler is incorrect, as the location information
+is lost.
+
 .. _dune-files:
 
 dune

diff --git a/src/dune_engine/dune_project.ml b/src/dune_engine/dune_project.ml
@@ -139,6 +139,7 @@ type t =
   ; parsing_context : Univ_map.t
   ; implicit_transitive_deps : bool
   ; wrapped_executables : bool
+  ; map_workspace_root : bool
   ; executables_implicit_empty_intf : bool
   ; accept_alternative_dune_file_name : bool
   ; generate_opam_files : bool
@@ -201,6 +202,7 @@ let to_dyn
     ; packages
     ; implicit_transitive_deps
     ; wrapped_executables
+    ; map_workspace_root
     ; executables_implicit_empty_intf
     ; accept_alternative_dune_file_name
     ; generate_opam_files
@@ -227,6 +229,7 @@ let to_dyn
           (Package.Name.Map.to_list packages) )
     ; ("implicit_transitive_deps", bool implicit_transitive_deps)
     ; ("wrapped_executables", bool wrapped_executables)
+    ; ("map_workspace_root", bool map_workspace_root)
     ; ("executables_implicit_empty_intf", bool executables_implicit_empty_intf)
     ; ( "accept_alternative_dune_file_name"
       , bool accept_alternative_dune_file_name )
@@ -454,6 +457,8 @@ let implicit_transitive_deps_default ~lang:_ = true
 let wrapped_executables_default ~(lang : Lang.Instance.t) =
   lang.version >= (2, 0)
 
+let map_workspace_root_default ~(lang : Lang.Instance.t) = lang.version >= (3, 0)
+
 let executables_implicit_empty_intf_default ~(lang : Lang.Instance.t) =
   lang.version >= (3, 0)
 
@@ -506,6 +511,7 @@ let infer ~dir ?(info = Package.Info.empty) packages =
   in
   let implicit_transitive_deps = implicit_transitive_deps_default ~lang in
   let wrapped_executables = wrapped_executables_default ~lang in
+  let map_workspace_root = map_workspace_root_default ~lang in
   let executables_implicit_empty_intf =
     executables_implicit_empty_intf_default ~lang
   in
@@ -523,6 +529,7 @@ let infer ~dir ?(info = Package.Info.empty) packages =
   ; dune_version = lang.version
   ; implicit_transitive_deps
   ; wrapped_executables
+  ; map_workspace_root
   ; executables_implicit_empty_intf
   ; accept_alternative_dune_file_name = false
   ; stanza_parser
@@ -591,6 +598,7 @@ let encode : t -> Dune_lang.t list =
      ; packages
      ; implicit_transitive_deps
      ; wrapped_executables
+     ; map_workspace_root
      ; executables_implicit_empty_intf
      ; accept_alternative_dune_file_name
      ; generate_opam_files
@@ -636,6 +644,7 @@ let encode : t -> Dune_lang.t list =
           implicit_transitive_deps_default
       ; flag "wrapped_executables" wrapped_executables
           wrapped_executables_default
+      ; flag "map_workspace_root" map_workspace_root map_workspace_root_default
       ; flag "executables_implicit_empty_intf" executables_implicit_empty_intf
           executables_implicit_empty_intf_default
       ; flag "strict_package_deps" strict_package_deps
@@ -717,6 +726,9 @@ let parse ~dir ~lang ~file ~dir_status =
         and+ wrapped_executables =
           field_o_b "wrapped_executables"
             ~check:(Dune_lang.Syntax.since Stanza.syntax (1, 11))
+        and+ map_workspace_root =
+          field_o_b "map_workspace_root"
+            ~check:(Dune_lang.Syntax.since Stanza.syntax (3, 7))
         and+ _allow_approx_merlin =
           (* TODO DUNE3 remove this field from parsing *)
           let+ loc = loc
@@ -886,6 +898,10 @@ let parse ~dir ~lang ~file ~dir_status =
             Option.value wrapped_executables
               ~default:(wrapped_executables_default ~lang)
           in
+          let map_workspace_root =
+            Option.value map_workspace_root
+              ~default:(map_workspace_root_default ~lang)
+          in
           let executables_implicit_empty_intf =
             Option.value executables_implicit_empty_intf
               ~default:(executables_implicit_empty_intf_default ~lang)
@@ -959,6 +975,7 @@ let parse ~dir ~lang ~file ~dir_status =
           ; parsing_context
           ; implicit_transitive_deps
           ; wrapped_executables
+          ; map_workspace_root
           ; executables_implicit_empty_intf
           ; accept_alternative_dune_file_name
           ; generate_opam_files
@@ -1015,6 +1032,8 @@ let set_parsing_context t parser =
 
 let wrapped_executables t = t.wrapped_executables
 
+let map_workspace_root t = t.map_workspace_root
+
 let executables_implicit_empty_intf t = t.executables_implicit_empty_intf
 
 let accept_alternative_dune_file_name t = t.accept_alternative_dune_file_name
@@ -1036,3 +1055,5 @@ let update_execution_parameters t ep =
   |> Execution_parameters.set_dune_version t.dune_version
   |> 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
diff --git a/src/dune_engine/dune_project.mli b/src/dune_engine/dune_project.mli
@@ -180,6 +180,8 @@ val dune_version : t -> Dune_lang.Syntax.Version.t
 
 val wrapped_executables : t -> bool
 
+val map_workspace_root : t -> bool
+
 val executables_implicit_empty_intf : t -> bool
 
 val accept_alternative_dune_file_name : t -> bool

diff --git a/src/dune_engine/execution_parameters.ml b/src/dune_engine/execution_parameters.ml
@@ -24,38 +24,45 @@ type t =
   ; action_stdout_on_success : Action_output_on_success.t
   ; action_stderr_on_success : Action_output_on_success.t
   ; expand_aliases_in_sandbox : bool
+  ; add_workspace_root_to_build_path_prefix_map : bool
   }
 
 let equal
     { dune_version
     ; action_stdout_on_success
     ; action_stderr_on_success
     ; expand_aliases_in_sandbox
+    ; add_workspace_root_to_build_path_prefix_map
     } t =
   Dune_lang.Syntax.Version.equal dune_version t.dune_version
   && Action_output_on_success.equal action_stdout_on_success
        t.action_stdout_on_success
   && Action_output_on_success.equal action_stderr_on_success
        t.action_stderr_on_success
   && 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
 
 let hash
     { dune_version
     ; action_stdout_on_success
     ; action_stderr_on_success
     ; expand_aliases_in_sandbox
+    ; add_workspace_root_to_build_path_prefix_map
     } =
   Poly.hash
     ( Dune_lang.Syntax.Version.hash dune_version
     , Action_output_on_success.hash action_stdout_on_success
     , Action_output_on_success.hash action_stderr_on_success
-    , expand_aliases_in_sandbox )
+    , expand_aliases_in_sandbox
+    , add_workspace_root_to_build_path_prefix_map )
 
 let to_dyn
     { dune_version
     ; action_stdout_on_success
     ; action_stderr_on_success
     ; expand_aliases_in_sandbox
+    ; add_workspace_root_to_build_path_prefix_map
     } =
   Dyn.Record
     [ ("dune_version", Dune_lang.Syntax.Version.to_dyn dune_version)
@@ -64,13 +71,16 @@ let to_dyn
     ; ( "action_stderr_on_success"
       , Action_output_on_success.to_dyn action_stderr_on_success )
     ; ("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 )
     ]
 
 let builtin_default =
   { dune_version = Dune_lang.Stanza.latest_version
   ; action_stdout_on_success = Print
   ; action_stderr_on_success = Print
   ; expand_aliases_in_sandbox = true
+  ; add_workspace_root_to_build_path_prefix_map = true
   }
 
 let set_dune_version x t = { t with dune_version = x }
@@ -81,15 +91,19 @@ let set_action_stderr_on_success x t = { t with action_stderr_on_success = 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 dune_version t = t.dune_version
 
 let should_remove_write_permissions_on_generated_files t =
   t.dune_version >= (2, 4)
 
-let add_workspace_root_to_build_path_prefix_map t = t.dune_version >= (3, 0)
-
 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 action_stdout_on_success t = t.action_stdout_on_success
 
 let action_stderr_on_success t = t.action_stderr_on_success

diff --git a/src/dune_engine/execution_parameters.mli b/src/dune_engine/execution_parameters.mli
@@ -52,6 +52,8 @@ val set_action_stderr_on_success : Action_output_on_success.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
 
 (** As configured by [init] *)

diff --git a/test/blackbox-tests/test-cases/map-workspace-root-disabled.t b/test/blackbox-tests/test-cases/map-workspace-root-disabled.t
@@ -0,0 +1,21 @@
+Check that Dune does not do rewriting of build directory to /workspace_root
+if inhibited.
+
+  $ cat > dune-project << EOF
+  > (lang dune 3.7)
+  > (map_workspace_root false)
+  > EOF
+  $ cat > dune << "EOF"
+  > (rule
+  >  (target x)
+  >  (action (system "dune_cmd rewrite-path $PWD | grep -c /workspace_root; touch x")))
+  > EOF
+
+  $ dune build
+  0
+
+It works with sandboxing as well:
+
+  $ dune clean
+  $ dune build --sandbox copy
+  0
diff --git a/test/blackbox-tests/test-cases/map-workspace-root-enabled.t b/test/blackbox-tests/test-cases/map-workspace-root-enabled.t
@@ -0,0 +1,21 @@
+Check that Dune does not do rewriting of build directory to /workspace_root
+if inhibited.
+
+  $ cat > dune-project << EOF
+  > (lang dune 3.7)
+  > (map_workspace_root true)
+  > EOF
+  $ cat > dune << "EOF"
+  > (rule
+  >  (target x)
+  >  (action (system "dune_cmd rewrite-path $PWD | grep -c /workspace_root; touch x")))
+  > EOF
+
+  $ dune build
+  1
+
+It works with sandboxing as well:
+
+  $ dune clean
+  $ dune build --sandbox copy
+  1