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 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. Signed-off-by: Richard L Ford <[email protected]> Fixes ocaml#6929.
richardlford · Feb 6, 2023 · c069e10 · c069e10
1 parent 3076e67
commit c069e10
Show file tree

Hide file tree

Showing 5 changed files with 66 additions and 3 deletions.
diff --git a/doc/dune-files.rst b/doc/dune-files.rst
@@ -437,6 +437,28 @@ 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
+-------------------
+
+It is desirable that the output of tools not contain references to the
+file system location from which they were built. Starting from Dune 3.6,
+Dune has mapped references to the workspace directory to "/workspace_root".
+
+Starting from Dune 3.6x, an option is available to turn on/off mapping
+of the workspace on a per-project basis:
+
+.. code:: scheme
+
+    (map_workspace_root <bool>)
+
+Starting with Dune 3.6, Dune does this mapping by default. However,
+this can still be turned off using ``(map_workspace_root false)``
+Note that when this mapping is enabled, the debug information produced
+by the byte-code 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,9 @@ 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, 6)
+
 let executables_implicit_empty_intf_default ~(lang : Lang.Instance.t) =
   lang.version >= (3, 0)
 
@@ -506,6 +512,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 +530,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 +599,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 +645,8 @@ 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 +728,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, 6))
         and+ _allow_approx_merlin =
           (* TODO DUNE3 remove this field from parsing *)
           let+ loc = loc
@@ -885,6 +899,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)
@@ -958,6 +976,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
@@ -1014,6 +1033,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
@@ -1035,3 +1056,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] *)