Rewrite install root based paths

To achieve reproducible builds, currently Dune rewrites paths based of the current build directory. However it misses paths based on the OCaml installation directory (usually ~/.opam/switch). This change also maps paths in the installation tree to abstract paths headed by "/workspace_root". Signed-off-by: Richard L Ford <[email protected]>
ocaml · May 16, 2023 · b04df9e · b04df9e
1 parent f6e974a
commit b04df9e
Show file tree

Hide file tree

Showing 17 changed files with 312 additions and 255 deletions.
diff --git a/src/dune_engine/action_exec.ml b/src/dune_engine/action_exec.ml
@@ -542,6 +542,34 @@ type input =
   ; action : Action.t
   }
 
+module Install_root = struct
+  let path_sep = if Sys.win32 then ';' else ':'
+
+  let ( / ) = Filename.concat
+
+  let exe = if Sys.win32 then ".exe" else ""
+
+  let best_prog dir prog =
+    let fn = (dir / prog) ^ ".opt" ^ exe in
+    if Sys.file_exists fn then Some fn
+    else
+      let fn = (dir / prog) ^ exe in
+      if Sys.file_exists fn then Some fn else None
+
+  let find_ocaml_prog path prog =
+    List.find_map path ~f:(fun dir -> best_prog dir prog)
+
+  let get (env : Env.t) =
+    match Env.get env "OPAM_SWITCH_PREFIX" with
+    | Some dir -> Some dir
+    | None ->
+      let open Option.O in
+      let* path_string = Env.get env "PATH" in
+      let path = String.split path_string ~on:path_sep in
+      let+ ocamlc = find_ocaml_prog path "ocamlc" in
+      Filename.dirname (Filename.dirname ocamlc)
+end
+
 let exec
     { targets; root; context; env; rule_loc; execution_parameters; action = t }
     ~build_deps =
@@ -558,11 +586,16 @@ let exec
       | true ->
         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"
-              }
-          ]
+          ([ Some
+               { Build_path_prefix_map.source = Path.to_absolute_filename root
+               ; target = "/workspace_root"
+               }
+           ]
+          @
+          match Install_root.get env with
+          | None -> []
+          | Some install_root ->
+            [ Some { source = install_root; target = "/workspace_root" } ])
     in
     { working_dir = Path.root
     ; env

diff --git a/test/blackbox-tests/test-cases/github1946.t/run.t b/test/blackbox-tests/test-cases/github1946.t/run.t
@@ -7,7 +7,7 @@ in the same dune file, but require different ppx specifications
   $ dune build @all --profile release
   $ dune ocaml merlin dump-config $PWD
   Usesppx1
-  ((STDLIB /OCAMLC_WHERE)
+  ((STDLIB /workspace_root/lib/ocaml)
    (EXCLUDE_QUERY_DIR)
    (B
     $TESTCASE_ROOT/_build/default/.usesppx1.objs/byte)
@@ -21,7 +21,7 @@ in the same dune file, but require different ppx specifications
      'library-name="usesppx1"'"))
    (FLG (-w -40 -g)))
   Usesppx2
-  ((STDLIB /OCAMLC_WHERE)
+  ((STDLIB /workspace_root/lib/ocaml)
    (EXCLUDE_QUERY_DIR)
    (B
     $TESTCASE_ROOT/_build/default/.usesppx2.objs/byte)

diff --git a/test/blackbox-tests/test-cases/github759.t/run.t b/test/blackbox-tests/test-cases/github759.t/run.t
@@ -4,7 +4,7 @@
   $ dune build foo.cma --profile release
   $ dune ocaml merlin dump-config $PWD
   Foo
-  ((STDLIB /OCAMLC_WHERE)
+  ((STDLIB /workspace_root/lib/ocaml)
    (EXCLUDE_QUERY_DIR)
    (B
     $TESTCASE_ROOT/_build/default/.foo.objs/byte)
@@ -16,7 +16,7 @@
   $ dune build foo.cma --profile release
   $ dune ocaml merlin dump-config $PWD
   Foo
-  ((STDLIB /OCAMLC_WHERE)
+  ((STDLIB /workspace_root/lib/ocaml)
    (EXCLUDE_QUERY_DIR)
    (B
     $TESTCASE_ROOT/_build/default/.foo.objs/byte)
@@ -28,7 +28,7 @@
   $ dune build foo.cma --profile release
   $ dune ocaml merlin dump-config $PWD
   Foo
-  ((STDLIB /OCAMLC_WHERE)
+  ((STDLIB /workspace_root/lib/ocaml)
    (EXCLUDE_QUERY_DIR)
    (B
     $TESTCASE_ROOT/_build/default/.foo.objs/byte)

diff --git a/test/blackbox-tests/test-cases/install-dir/install-libdir.t/run.t b/test/blackbox-tests/test-cases/install-dir/install-libdir.t/run.t
diff --git a/test/blackbox-tests/test-cases/melange/merlin.t b/test/blackbox-tests/test-cases/melange/merlin.t
@@ -34,21 +34,21 @@
 Paths to Melange stdlib appear in B and S entries without melange.emit stanza
 
   $ dune ocaml dump-dot-merlin $PWD | grep -e "^B " -e "^S "
-  B /MELC_STDLIB/melange
-  B /MELC_STDLIB/melange
-  B /MELC_STDLIB/melange
+  B /workspace_root/lib/melange/belt/melange
+  B /workspace_root/lib/melange/melange
+  B /workspace_root/lib/melange/runtime/melange
   B $TESTCASE_ROOT/_build/default/.foo.objs/melange
-  S /MELC_STDLIB
-  S /MELC_STDLIB
-  S /MELC_STDLIB
+  S /workspace_root/lib/melange
+  S /workspace_root/lib/melange/belt
+  S /workspace_root/lib/melange/runtime
   S $TESTCASE_ROOT
 
 All 3 modules (Foo, Foo__ and Bar) contain a ppx directive
 
   $ dune ocaml merlin dump-config $PWD | grep -i "ppx"
-   (FLG (-ppx "/MELC_COMPILER -as-ppx"))
-   (FLG (-ppx "/MELC_COMPILER -as-ppx"))
-   (FLG (-ppx "/MELC_COMPILER -as-ppx"))
+   (FLG (-ppx "/workspace_root/bin/melc -as-ppx"))
+   (FLG (-ppx "/workspace_root/bin/melc -as-ppx"))
+   (FLG (-ppx "/workspace_root/bin/melc -as-ppx"))
 
   $ target=output
   $ cat >dune <<EOF
@@ -65,22 +65,22 @@ All 3 modules (Foo, Foo__ and Bar) contain a ppx directive
 The melange.emit entry contains a ppx directive
 
   $ dune ocaml merlin dump-config $PWD | grep -i "ppx"
-   (FLG (-ppx "/MELC_COMPILER -as-ppx"))
+   (FLG (-ppx "/workspace_root/bin/melc -as-ppx"))
 
 Dump-dot-merlin includes the melange flags
 
   $ dune ocaml dump-dot-merlin $PWD
   EXCLUDE_QUERY_DIR
-  STDLIB /MELC_STDLIB/melange
-  B /MELC_STDLIB/melange
-  B /MELC_STDLIB/melange
-  B /MELC_STDLIB/melange
+  STDLIB /workspace_root/lib/melange/melange
+  B /workspace_root/lib/melange/belt/melange
+  B /workspace_root/lib/melange/melange
+  B /workspace_root/lib/melange/runtime/melange
   B $TESTCASE_ROOT/_build/default/.output.mobjs/melange
-  S /MELC_STDLIB
-  S /MELC_STDLIB
-  S /MELC_STDLIB
+  S /workspace_root/lib/melange
+  S /workspace_root/lib/melange/belt
+  S /workspace_root/lib/melange/runtime
   S $TESTCASE_ROOT
-  # FLG -ppx '/MELC_COMPILER -as-ppx'
+  # FLG -ppx '/workspace_root/bin/melc -as-ppx'
   # FLG -w @[email protected]@30..39@[email protected]@[email protected]@67@69-40 -strict-sequence -strict-formats -short-paths -keep-locs -g
   
 
@@ -123,7 +123,7 @@ Melange ppx should appear after user ppx, so that Merlin applies the former firs
 
   $ dune ocaml merlin dump-config $PWD | grep -v "(B "  | grep -v "(S "
   Bar
-  ((STDLIB /MELC_STDLIB/melange)
+  ((STDLIB /workspace_root/lib/melange/melange)
    (EXCLUDE_QUERY_DIR)
    (B
     $TESTCASE_ROOT/_build/default/.foo.objs/melange)
@@ -136,7 +136,7 @@ Melange ppx should appear after user ppx, so that Merlin applies the former firs
      --as-ppx
      --cookie
      'library-name="foo"'"))
-   (FLG (-ppx "/MELC_COMPILER -as-ppx"))
+   (FLG (-ppx "/workspace_root/bin/melc -as-ppx"))
    (FLG
     (-w
      @1..3@5..28@30..39@43@46..47@49..57@61..62@67@69-40
@@ -146,7 +146,7 @@ Melange ppx should appear after user ppx, so that Merlin applies the former firs
      -keep-locs
      -g)))
   Foo
-  ((STDLIB /MELC_STDLIB/melange)
+  ((STDLIB /workspace_root/lib/melange/melange)
    (EXCLUDE_QUERY_DIR)
    (B
     $TESTCASE_ROOT/_build/default/.foo.objs/melange)
@@ -158,7 +158,7 @@ Melange ppx should appear after user ppx, so that Merlin applies the former firs
      --as-ppx
      --cookie
      'library-name="foo"'"))
-   (FLG (-ppx "/MELC_COMPILER -as-ppx"))
+   (FLG (-ppx "/workspace_root/bin/melc -as-ppx"))
    (FLG
     (-w
      @1..3@5..28@30..39@43@46..47@49..57@61..62@67@69-40
@@ -168,7 +168,7 @@ Melange ppx should appear after user ppx, so that Merlin applies the former firs
      -keep-locs
      -g)))
   Fooppx
-  ((STDLIB /OCAMLC_WHERE)
+  ((STDLIB /workspace_root/lib/ocaml)
    (EXCLUDE_QUERY_DIR)
    (B
     $TESTCASE_ROOT/_build/default/.fooppx.objs/byte)

diff --git a/test/blackbox-tests/test-cases/merlin/default-based-context.t/run.t b/test/blackbox-tests/test-cases/merlin/default-based-context.t/run.t
@@ -1,5 +1,5 @@
   $ export BUILD_PATH_PREFIX_MAP=\
-  > "OPAM_PREFIX=$(ocamlc -where):$BUILD_PATH_PREFIX_MAP"
+  > "workspace_root=$(ocamlc -where):$BUILD_PATH_PREFIX_MAP"
 
 If Merlin field is absent, default context is chosen
 
@@ -23,7 +23,7 @@ If Merlin field is absent, default context is chosen
 
   $ dune ocaml merlin dump-config "$PWD"
   Foo
-  ((STDLIB OPAM_PREFIX)
+  ((STDLIB /workspace_root/lib/ocaml)
    (EXCLUDE_QUERY_DIR)
    (B
     $TESTCASE_ROOT/_build/default/.foo.objs/byte)
@@ -61,7 +61,7 @@ If Merlin field is present, this context is chosen
 
   $ dune ocaml merlin dump-config "$PWD"
   Foo
-  ((STDLIB OPAM_PREFIX)
+  ((STDLIB /workspace_root/lib/ocaml)
    (EXCLUDE_QUERY_DIR)
    (B
     $TESTCASE_ROOT/_build/cross/.foo.objs/byte)

diff --git a/test/blackbox-tests/test-cases/merlin/dump-dot-merlin.t/run.t b/test/blackbox-tests/test-cases/merlin/dump-dot-merlin.t/run.t
@@ -1,18 +1,18 @@
   $ ocamlc_where="$(ocamlc -where)"
-  $ export BUILD_PATH_PREFIX_MAP="/OCAMLC_WHERE=$ocamlc_where:$BUILD_PATH_PREFIX_MAP"
+  $ export BUILD_PATH_PREFIX_MAP="/workspace_root/lib/ocaml=$ocamlc_where:$BUILD_PATH_PREFIX_MAP"
 
   $ dune build
   $ dune ocaml dump-dot-merlin src\ with\ spaces
   EXCLUDE_QUERY_DIR
-  STDLIB /OCAMLC_WHERE
+  STDLIB /workspace_root/lib/ocaml
   B $TESTCASE_ROOT/_build/default/src with spaces/.foo.eobjs/byte
   S $TESTCASE_ROOT/src with spaces
   # FLG -pp ''\''$TESTCASE_ROOT/_build/default/p p/pp.exe'\'''
   # FLG -w @[email protected]@30..39@[email protected]@[email protected] -strict-sequence -strict-formats -short-paths -keep-locs -g
   
   $ dune ocaml dump-dot-merlin "p p"
   EXCLUDE_QUERY_DIR
-  STDLIB /OCAMLC_WHERE
+  STDLIB /workspace_root/lib/ocaml
   B $TESTCASE_ROOT/_build/default/p p/.pp.eobjs/byte
   S $TESTCASE_ROOT/p p
   # FLG -w @[email protected]@30..39@[email protected]@[email protected] -strict-sequence -strict-formats -short-paths -keep-locs -g

diff --git a/test/blackbox-tests/test-cases/merlin/github4125.t/run.t b/test/blackbox-tests/test-cases/merlin/github4125.t/run.t
@@ -22,7 +22,7 @@ We call `$(opam switch show)` so that this test always uses an existing switch
 
   $ dune ocaml merlin dump-config "$PWD"
   Foo
-  ((STDLIB /OCAMLC_WHERE)
+  ((STDLIB /workspace_root/lib/ocaml)
    (EXCLUDE_QUERY_DIR)
    (B
     $TESTCASE_ROOT/_build/cross/.foo.objs/byte)

diff --git a/test/blackbox-tests/test-cases/merlin/instrumentation.t/run.t b/test/blackbox-tests/test-cases/merlin/instrumentation.t/run.t
@@ -9,7 +9,7 @@ up a project with instrumentation and testing checking the merlin config.
   $ dune build --instrument-with hello ./lib/.merlin-conf/lib-foo ./lib/.merlin-conf/lib-bar --profile release
   $ dune ocaml merlin dump-config $PWD/lib
   Bar
-  ((STDLIB /OCAMLC_WHERE)
+  ((STDLIB /workspace_root/lib/ocaml)
    (EXCLUDE_QUERY_DIR)
    (B
     $TESTCASE_ROOT/_build/default/lib/.bar.objs/byte)
@@ -23,7 +23,7 @@ up a project with instrumentation and testing checking the merlin config.
     $TESTCASE_ROOT/ppx)
    (FLG (-w -40 -g)))
   File
-  ((STDLIB /OCAMLC_WHERE)
+  ((STDLIB /workspace_root/lib/ocaml)
    (EXCLUDE_QUERY_DIR)
    (B
     $TESTCASE_ROOT/_build/default/lib/.bar.objs/byte)
@@ -38,16 +38,16 @@ up a project with instrumentation and testing checking the merlin config.
    (FLG (-open Bar))
    (FLG (-w -40 -g)))
   Foo
-  ((STDLIB /OCAMLC_WHERE)
+  ((STDLIB /workspace_root/lib/ocaml)
    (EXCLUDE_QUERY_DIR)
-   (B lib/findlib)
-   (B /OCAMLC_WHERE)
+   (B /workspace_root/lib/findlib)
+   (B /workspace_root/lib/ocaml)
    (B
     $TESTCASE_ROOT/_build/default/lib/.foo.objs/byte)
    (B
     $TESTCASE_ROOT/_build/default/ppx/.hello.objs/byte)
-   (S lib/findlib)
-   (S /OCAMLC_WHERE)
+   (S /workspace_root/lib/findlib)
+   (S /workspace_root/lib/ocaml)
    (S
     $TESTCASE_ROOT/lib)
    (S
@@ -56,16 +56,16 @@ up a project with instrumentation and testing checking the merlin config.
     $TESTCASE_ROOT/ppx)
    (FLG (-w -40 -g)))
   Privmod
-  ((STDLIB /OCAMLC_WHERE)
+  ((STDLIB /workspace_root/lib/ocaml)
    (EXCLUDE_QUERY_DIR)
-   (B lib/findlib)
-   (B /OCAMLC_WHERE)
+   (B /workspace_root/lib/findlib)
+   (B /workspace_root/lib/ocaml)
    (B
     $TESTCASE_ROOT/_build/default/lib/.foo.objs/byte)
    (B
     $TESTCASE_ROOT/_build/default/ppx/.hello.objs/byte)
-   (S lib/findlib)
-   (S /OCAMLC_WHERE)
+   (S /workspace_root/lib/findlib)
+   (S /workspace_root/lib/ocaml)
    (S
     $TESTCASE_ROOT/lib)
    (S

diff --git a/test/blackbox-tests/test-cases/merlin/merlin-from-subdir.t/run.t b/test/blackbox-tests/test-cases/merlin/merlin-from-subdir.t/run.t
@@ -8,7 +8,7 @@ We build the project
 Verify that merlin configuration was generated...
   $ dune ocaml merlin dump-config $PWD
   Test
-  ((STDLIB /OCAMLC_WHERE)
+  ((STDLIB /workspace_root/lib/ocaml)
    (EXCLUDE_QUERY_DIR)
    (B
     $TESTCASE_ROOT/_build/default/.foo.objs/byte)
@@ -27,7 +27,7 @@ Verify that merlin configuration was generated...
      -keep-locs
      -g)))
   Foo
-  ((STDLIB /OCAMLC_WHERE)
+  ((STDLIB /workspace_root/lib/ocaml)
    (EXCLUDE_QUERY_DIR)
    (B
     $TESTCASE_ROOT/_build/default/.foo.objs/byte)
@@ -52,7 +52,7 @@ Now we check that both querying from the root and the subfolder works
   $ FILE411=$PWD/411/test.ml
 
   $ printf "(4:File%d:%s)" ${#FILE} $FILE | dune ocaml-merlin | sed -E "s/[[:digit:]]+:/\?:/g"
-  ((?:STDLIB?:/OCAMLC_WHERE)(?:EXCLUDE_QUERY_DIR)(?:B?:$TESTCASE_ROOT/_build/default/.foo.objs/byte)(?:S?:$TESTCASE_ROOT)(?:S?:$TESTCASE_ROOT/411)(?:FLG(?:-w?:@1..3@5..28@30..39@43@46..47@49..57@61..62-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs?:-g)))
+  ((?:STDLIB?:/workspace_root/lib/ocaml)(?:EXCLUDE_QUERY_DIR)(?:B?:$TESTCASE_ROOT/_build/default/.foo.objs/byte)(?:S?:$TESTCASE_ROOT)(?:S?:$TESTCASE_ROOT/411)(?:FLG(?:-w?:@1..3@5[email protected]@[email protected]@[email protected]?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs?:-g)))
 
   $ printf "(4:File%d:%s)" ${#FILE411} $FILE411 | dune ocaml-merlin | sed -E "s/[[:digit:]]+:/\?:/g"
-  ((?:STDLIB?:/OCAMLC_WHERE)(?:EXCLUDE_QUERY_DIR)(?:B?:$TESTCASE_ROOT/_build/default/.foo.objs/byte)(?:B?:$TESTCASE_ROOT/_build/default/.test.eobjs/byte)(?:S?:$TESTCASE_ROOT)(?:S?:$TESTCASE_ROOT/411)(?:FLG(?:-w?:@1..3@5..28@30..39@43@46..47@49..57@61..62-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs?:-g)))
+  ((?:STDLIB?:/workspace_root/lib/ocaml)(?:EXCLUDE_QUERY_DIR)(?:B?:$TESTCASE_ROOT/_build/default/.foo.objs/byte)(?:B?:$TESTCASE_ROOT/_build/default/.test.eobjs/byte)(?:S?:$TESTCASE_ROOT)(?:S?:$TESTCASE_ROOT/411)(?:FLG(?:-w?:@1..3@5[email protected]@[email protected]@[email protected]?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs?:-g)))