feat(pkg): relocatable compiler support

Signed-off-by: Ali Caglayan <alizter@gmail.com>

Author: Alizter

src/dune_pkg/lock_pkg.ml

@@ -97,13 +97,30 @@ let opam_variable_to_slang ~loc packages variable =
    with the following syntax:
 
      "%{?conf-g++:your-variable:}%"
+
+   Also handles the case where the conditional syntax %{pkg:var?then:else}%
+   was not correctly parsed by OpamTypesBase.filter_ident_of_string, which
+   only looks for '?' in the package part, not in the variable part.
 *)
 let desugar_special_string_interpolation_syntax
       ((packages, variable, string_converter) as fident)
   =
+  let var_str = OpamVariable.to_string variable in
   match string_converter with
+  | None when String.contains var_str '?' ->
+    (* Handle pkg:var?then or pkg:var?then:else syntax where the '?' ended up
+       in the variable name instead of being parsed as a converter *)
+    (match String.lsplit2 var_str ~on:'?' with
+     | Some (var, rest) ->
+       let converter =
+         match String.lsplit2 rest ~on:':' with
+         | Some (then_, else_) -> Some (then_, else_)
+         | None -> Some (rest, "")
+       in
+       (packages, OpamVariable.of_string var, converter)
+     | None -> fident)
   | Some (package_and_variable, "")
-    when List.is_empty packages && String.is_empty (OpamVariable.to_string variable) ->
+    when List.is_empty packages && String.is_empty var_str ->
     (match String.lsplit2 package_and_variable ~on:':' with
      | Some (package, variable) ->
        ( [ Some (OpamPackage.Name.of_string package) ]

src/dune_rules/pkg_rules.ml

@@ -449,6 +449,9 @@ module Pkg = struct
     ; files_dir : Path.Build.t option
     ; pkg_digest : Pkg_digest.t
     ; mutable exported_env : string Env_update.t list
+    ; is_relocatable_compiler_context : bool
+      (* true if relocatable-compiler is in the lock directory, meaning
+         the compiler should be treated as a regular package *)
     }
 
   module Top_closure = Top_closure.Make (Id.Set) (Monad.Id)
@@ -525,13 +528,17 @@ module Pkg = struct
 
   let install_roots t =
     let default_install_roots = Paths.install_roots t.paths in
-    match Pkg_toolchain.is_compiler_and_toolchains_enabled t.info.name with
-    | false -> default_install_roots
-    | true ->
-      (* Compiler packages store their libraries in a subdirectory named "ocaml". *)
-      { default_install_roots with
-        lib_root = Path.relative default_install_roots.lib_root "ocaml"
-      }
+    (* Skip toolchain handling if this is a relocatable compiler context *)
+    if t.is_relocatable_compiler_context
+    then default_install_roots
+    else (
+      match Pkg_toolchain.is_compiler_and_toolchains_enabled t.info.name ~dep_names:[] with
+      | false -> default_install_roots
+      | true ->
+        (* Compiler packages store their libraries in a subdirectory named "ocaml". *)
+        { default_install_roots with
+          lib_root = Path.relative default_install_roots.lib_root "ocaml"
+        })
   ;;
 
   (* Given a list of packages, construct an env containing variables
@@ -1360,6 +1367,11 @@ module DB = struct
     { id = Id.gen (); pkg_digest_table; system_provided }
   ;;
 
+  let all_package_names t =
+    Pkg_digest.Map.fold t.pkg_digest_table ~init:[] ~f:(fun entry acc ->
+      entry.pkg.info.name :: acc)
+  ;;
+
   let pkg_digest_of_name lock_dir platform pkg_name ~system_provided =
     let entries_by_name =
       Pkg_table.entries_by_name_of_lock_dir lock_dir ~platform ~system_provided
@@ -1584,9 +1596,14 @@ end = struct
       let install_command = Option.map install_command ~f:relocate in
       let build_command = choose_for_current_platform build_command in
       let build_command = Option.map build_command ~f:relocate_build in
+      (* Check if relocatable-compiler is in the lock directory. This means
+         the compiler should be treated as a regular package, not cached in
+         the toolchains directory. *)
+      let all_pkg_names = DB.all_package_names db in
+      let is_relocatable_compiler_context = Pkg_toolchain.is_relocatable_compiler all_pkg_names in
       let paths =
         let paths = Paths.map_path write_paths ~f:Path.build in
-        match Pkg_toolchain.is_compiler_and_toolchains_enabled info.name with
+        match Pkg_toolchain.is_compiler_and_toolchains_enabled info.name ~dep_names:all_pkg_names with
         | false -> paths
         | true ->
           (* Modify the environment as well as build and install commands for
@@ -1623,6 +1640,7 @@ end = struct
         ; files_dir
         ; pkg_digest
         ; exported_env = []
+        ; is_relocatable_compiler_context
         }
       in
       let+ exported_env =
@@ -1929,6 +1947,38 @@ module Install_action = struct
         Some (entry.section, dst)
     ;;
 
+    let rec resolve_symlinks_in dir =
+      match Readdir.read_directory_with_kinds dir with
+      | Error e -> Unix_error.Detailed.raise e
+      | Ok entries ->
+        List.iter entries ~f:(fun (fname, kind) ->
+          let path = Filename.concat dir fname in
+          match (kind : Unix.file_kind) with
+          | S_DIR -> resolve_symlinks_in path
+          | S_LNK ->
+            (match Fpath.follow_symlink path with
+             | Error (Unix_error e) -> Unix_error.Detailed.raise e
+             | Error Not_a_symlink ->
+               Code_error.raise
+                 "resolve_symlinks_in: not a symlink"
+                 [ "path", Dyn.string path ]
+             | Error Max_depth_exceeded ->
+               User_error.raise
+                 [ Pp.textf
+                     "Unable to resolve symlink %s: too many levels of symbolic links"
+                     path
+                 ]
+             | Ok resolved ->
+               (match Unix.lstat resolved with
+                | { Unix.st_kind = S_REG; _ } ->
+                  Fpath.unlink_exn path;
+                  Io.portable_hardlink
+                    ~src:(Path.of_string resolved)
+                    ~dst:(Path.of_string path)
+                | _ -> ()))
+          | _ -> ())
+    ;;
+
     let action
           { package
           ; install_file
@@ -2016,9 +2066,14 @@ module Install_action = struct
         let+ variables = Async.async (fun () -> read_variables config_file) in
         { Install_cookie.Gen.files; variables }
       in
-      (* Produce the cookie file in the standard path *)
-      let cookie_file = Path.build @@ Paths.install_cookie' target_dir in
       Async.async (fun () ->
+        (* Resolve symlinks in target_dir so that the cache can store them. The
+         dune cache doesn't support symlinks, so we replace them with hardlinks
+         to their targets. *)
+        if Path.Untracked.exists (Path.build target_dir)
+        then resolve_symlinks_in (Path.Build.to_string target_dir);
+        (* Produce the cookie file in the standard path *)
+        let cookie_file = Path.build @@ Paths.install_cookie' target_dir in
         cookie_file |> Path.parent_exn |> Path.mkdir_p;
         Install_cookie.dump cookie_file cookies)
     ;;

src/dune_rules/pkg_toolchain.ml

@@ -47,8 +47,15 @@ let installation_prefix pkg =
   Path.Outside_build_dir.relative pkg_dir "target"
 ;;
 
-let is_compiler_and_toolchains_enabled name =
+let relocatable_package_name = Package.Name.of_string "relocatable-compiler"
+
+let is_relocatable_compiler dep_names =
+  List.exists dep_names ~f:(Package.Name.equal relocatable_package_name)
+;;
+
+let is_compiler_and_toolchains_enabled name ~dep_names =
   match Config.get Compile_time.toolchains with
+  | `Enabled when is_relocatable_compiler dep_names -> false
   | `Enabled -> Dune_pkg.Dev_tool.is_compiler_package name
   | `Disabled -> false
 ;;

src/dune_rules/pkg_toolchain.mli

@@ -5,6 +5,10 @@ open Import
     Set to [Dune_util.cache_home_dir/toolchains]. *)
 val base_dir : unit -> Path.Outside_build_dir.t
 
+(** Returns true if relocatable-compiler is in the given list of package names.
+    When true, the compiler should be treated as a regular package. *)
+val is_relocatable_compiler : Package.Name.t list -> bool
+
 (** Dune will download and build the ocaml-base-compiler and
     ocaml-variants packages into a user-wide directory (shared among
     projects) rather than using the usual package management mechanism to
@@ -18,7 +22,10 @@ val base_dir : unit -> Path.Outside_build_dir.t
     manage their compiler installation with opam or a system package
     manager, as compilers packages that would be installed by dune will
     not work correctly. *)
-val is_compiler_and_toolchains_enabled : Package.Name.t -> bool
+val is_compiler_and_toolchains_enabled
+  :  Package.Name.t
+  -> dep_names:Package.Name.t list
+  -> bool
 
 (** Returns the path to the directory containing the given package within the
     toolchain directory. This will be something like

test/blackbox-tests/test-cases/pkg/convert-opam-commands.t

@@ -269,7 +269,9 @@ Package with package conjunction and string selections inside variable interpola
   > build: [
   >   [ "echo" "a %{installed}% b" ]
   >   [ "echo" "c %{installed?x:y}% d" ]
+  >   [ "echo" "c2 %{installed?x}% d2" ]
   >   [ "echo" "e %{foo:installed?x:y}% f" ]
+  >   [ "echo" "e2 %{foo:installed?x}% f2" ]
   >   [ "echo" "g %{foo+bar+_:installed?x:y}% h" ]
   >   # The "enable" variable is syntactic sugar around "installed" in some (but not all) cases.
   >   # Its intention appears to be for use with ./configure scripts that take --enable-<feature> or
@@ -318,6 +320,12 @@ preserved between opam and dune.
           (if (catch_undefined_var %{pkg-self:installed} false) x y)
           "")
          " d"))
+       (run
+        echo
+        (concat
+         "c2 "
+         (if (catch_undefined_var %{pkg-self:installed} false) x "")
+         " d2"))
        (run
         echo
         (concat
@@ -326,6 +334,12 @@ preserved between opam and dune.
           (if (catch_undefined_var %{pkg:foo:installed} false) x y)
           "")
          " f"))
+       (run
+        echo
+        (concat
+         "e2 "
+         (if (catch_undefined_var %{pkg:foo:installed} false) x "")
+         " f2"))
        (run
         echo
         (concat

test/blackbox-tests/test-cases/pkg/install-symlinks/absolute-symlink-inside.t

@@ -0,0 +1,53 @@
+Test symlinks using absolute paths that point inside the target directory.
+Since we use realpath, these resolve correctly and work with caching.
+
+  $ export DUNE_CACHE=enabled
+  $ export DUNE_CACHE_ROOT=$PWD/_cache
+
+  $ make_lockdir
+
+  $ make_lockpkg foo <<EOF
+  > (version 0.0.1)
+  > (build
+  >  (progn
+  >   (run true BUILDING_FOO_PACKAGE)
+  >   (run mkdir -p %{lib}/%{pkg-self:name})
+  >   (write-file %{lib}/%{pkg-self:name}/real.txt "real content\n")
+  >   (run sh -c "ln -s \$(realpath %{lib}/%{pkg-self:name}/real.txt) %{lib}/%{pkg-self:name}/link.txt")
+  >   (write-file %{lib}/%{pkg-self:name}/META "")))
+  > EOF
+
+  $ cat > dune-project <<EOF
+  > (lang dune 3.22)
+  > (package
+  >  (name x)
+  >  (allow_empty)
+  >  (depends foo))
+  > EOF
+
+  $ build_pkg foo
+
+Verify the build ran:
+
+  $ count_trace BUILDING_FOO_PACKAGE
+  1
+
+The symlink is resolved to a regular file:
+
+  $ dune_cmd stat kind $(get_build_pkg_dir foo)/target/lib/foo/link.txt
+  regular file
+
+Both files are hardlinked:
+
+  $ dune_cmd stat hardlinks $(get_build_pkg_dir foo)/target/lib/foo/real.txt
+  3
+  $ dune_cmd stat hardlinks $(get_build_pkg_dir foo)/target/lib/foo/link.txt
+  3
+
+Clean and rebuild to verify cache restore:
+
+  $ rm -rf _build
+  $ build_pkg foo
+
+  $ count_trace BUILDING_FOO_PACKAGE
+  0

test/blackbox-tests/test-cases/pkg/install-symlinks/basic-caching.t

@@ -0,0 +1,71 @@
+Test that packages with symlinks in their install output are properly cached.
+Dune resolves symlinks to hardlinks so that the cache can store them.
+
+The compiler is one such package that has this kind of layout.
+
+  $ export DUNE_CACHE=enabled
+  $ export DUNE_CACHE_ROOT=$PWD/_cache
+
+  $ make_lockdir
+
+Create a package that installs both a regular file and a symlink to it.
+This is similar to how compilers install binaries (e.g., ocamlc -> ocamlc.opt).
+
+  $ make_lockpkg foo <<EOF
+  > (version 0.0.1)
+  > (build
+  >  (progn
+  >   (run true BUILDING_FOO_PACKAGE)
+  >   (run mkdir -p %{lib}/%{pkg-self:name})
+  >   (write-file %{lib}/%{pkg-self:name}/real.txt "real content\n")
+  >   (run ln -s real.txt %{lib}/%{pkg-self:name}/link.txt)
+  >   (write-file %{lib}/%{pkg-self:name}/META "")))
+  > EOF
+
+  $ cat > dune-project <<EOF
+  > (lang dune 3.22)
+  > (package
+  >  (name x)
+  >  (allow_empty)
+  >  (depends foo))
+  > EOF
+
+Build the package:
+
+  $ build_pkg foo
+
+Verify the build ran by checking the trace for our marker command:
+
+  $ count_trace BUILDING_FOO_PACKAGE
+  1
+
+Check that the files exist:
+
+  $ ls $(get_build_pkg_dir foo)/target/lib/foo | sort
+  META
+  link.txt
+  real.txt
+
+The symlink has been resolved to a regular file (hardlink to the target):
+
+  $ dune_cmd stat kind $(get_build_pkg_dir foo)/target/lib/foo/link.txt
+  regular file
+
+Check hardlink count. Files should have hardlinks > 1 indicating they are cached.
+real.txt has 3 hardlinks: original, link.txt (resolved), and cache entry.
+
+  $ dune_cmd stat hardlinks $(get_build_pkg_dir foo)/target/lib/foo/real.txt
+  3
+  $ dune_cmd stat hardlinks $(get_build_pkg_dir foo)/target/lib/foo/META
+  2
+
+Clean and rebuild to verify cache restore:
+
+  $ rm -rf _build
+  $ build_pkg foo
+
+The build command should not be rerun since it will be restored from cache.
+
+  $ count_trace BUILDING_FOO_PACKAGE
+  0
+

test/blackbox-tests/test-cases/pkg/install-symlinks/broken-symlink.t

@@ -0,0 +1,30 @@
+Test that broken symlinks are detected during symlink resolution.
+
+  $ make_lockdir
+
+  $ make_lockpkg foo <<EOF
+  > (version 0.0.1)
+  > (build
+  >  (progn
+  >   (run mkdir -p %{lib}/%{pkg-self:name})
+  >   (run ln -s nonexistent.txt %{lib}/%{pkg-self:name}/broken.txt)
+  >   (write-file %{lib}/%{pkg-self:name}/META "")))
+  > EOF
+
+  $ cat > dune-project <<EOF
+  > (lang dune 3.22)
+  > (package
+  >  (name x)
+  >  (allow_empty)
+  >  (depends foo))
+  > EOF
+
+The broken symlink is detected:
+
+  $ build_pkg foo 2>&1 | sanitize_pkg_digest foo.0.0.1 \
+  > | dune_cmd subst '\.sandbox/[a-f0-9]+' '.sandbox/$SANDBOX'
+  Error:
+  readlink(_build/.sandbox/$SANDBOX/_private/default/.pkg/foo.0.0.1-DIGEST_HASH/target/lib/foo/nonexistent.txt): No such file or directory
+  -> required by
+     _build/_private/default/.pkg/foo.0.0.1-DIGEST_HASH/target
+  [1]