Cross compilation: Also generate 'prefix'/'prefixexec' sections for .install files

Author: WardBrian

bin/install_uninstall.ml

@@ -57,11 +57,13 @@ let get_dirs context ~prefix_from_command_line ~from_command_line =
         ~hints:
           [ Pp.concat
               ~sep:Pp.space
-              [ Pp.text "It can be specified with"
-              ; User_message.command "--prefix"
-              ; Pp.textf "or by setting"
-              ; User_message.command (sprintf "--%s" name)
-              ]
+              ([ Pp.text "It can be specified with"; User_message.command "--prefix" ]
+               @
+               if String.equal name "prefix"
+               then []
+               else
+                 [ Pp.textf "or by setting"; User_message.command (sprintf "--%s" name) ]
+              )
             |> Pp.hovbox
           ]
   in
@@ -73,6 +75,7 @@ let get_dirs context ~prefix_from_command_line ~from_command_line =
   ; doc_root = must_be_defined "docdir" roots.doc_root
   ; share_root = must_be_defined "datadir" roots.share_root
   ; man = must_be_defined "mandir" roots.man
+  ; prefix = must_be_defined "prefix" roots.prefix
   }
 ;;
 
@@ -624,7 +627,7 @@ let run
     if relocatable
     then (
       match prefix_from_command_line with
-      | Some dir -> Some (Path.of_string dir)
+      | Some dir -> Some (Path.of_string_allow_outside_workspace dir)
       | None ->
         User_error.raise
           [ Pp.concat
@@ -853,16 +856,18 @@ let make ~what =
     let common, config = Common.init builder in
     Scheduler_setup.no_build_no_rpc ~config (fun () ->
       let from_command_line =
-        { Install.Roots.lib_root = libdir_from_command_line
-        ; etc_root = etcdir_from_command_line
-        ; doc_root = docdir_from_command_line
-        ; man = mandir_from_command_line
-        ; bin = bindir_from_command_line
-        ; sbin = sbindir_from_command_line
-        ; libexec_root = libexecdir_from_command_line
-        ; share_root = datadir_from_command_line
+        let path_of_string = Option.map ~f:Path.of_string in
+        { Install.Roots.lib_root = path_of_string libdir_from_command_line
+        ; etc_root = path_of_string etcdir_from_command_line
+        ; doc_root = path_of_string docdir_from_command_line
+        ; man = path_of_string mandir_from_command_line
+        ; bin = path_of_string bindir_from_command_line
+        ; sbin = path_of_string sbindir_from_command_line
+        ; libexec_root = path_of_string libexecdir_from_command_line
+        ; share_root = path_of_string datadir_from_command_line
+        ; prefix =
+            Option.map ~f:Path.of_string_allow_outside_workspace prefix_from_command_line
         }
-        |> Install.Roots.map ~f:(Option.map ~f:Path.of_string)
         |> Install.Roots.complete
       in
       run

boot/configure.ml

@@ -129,6 +129,7 @@ let () =
   pr "  ; bin = %s" (option string !bindir);
   pr "  ; sbin = %s" (option string !sbindir);
   pr "  ; libexec_root = %s" (option string !libexecdir);
+  pr "  ; prefix = %s" (option string !prefix);
   pr "  }";
   pr "";
   pr "let prefix : string option = %s" (option string !prefix);

otherlibs/dune-private-libs/section/dune_section.ml

@@ -13,6 +13,8 @@ type t =
   | Stublibs
   | Man
   | Misc
+  | Prefix
+  | Prefixexec
 
 let all =
   [ Lib, "lib"
@@ -29,6 +31,8 @@ let all =
   ; Stublibs, "stublibs"
   ; Man, "man"
   ; Misc, "misc"
+  ; Prefix, "prefix"
+  ; Prefixexec, "prefixexec"
   ]
 ;;
 

otherlibs/dune-private-libs/section/dune_section.mli

@@ -13,6 +13,8 @@ type t =
   | Stublibs
   | Man
   | Misc
+  | Prefix
+  | Prefixexec
 
 val all : (t * string) list
 val of_string : string -> t option

src/dune_lang/section.ml

@@ -41,6 +41,7 @@ let encode v =
 let all = Set.of_list (List.map ~f:fst Dune_section.all)
 
 let should_set_executable_bit = function
-  | Lib | Lib_root | Toplevel | Share | Share_root | Etc | Doc | Man | Misc -> false
-  | Libexec | Libexec_root | Bin | Sbin | Stublibs -> true
+  | Lib | Lib_root | Toplevel | Share | Share_root | Etc | Doc | Man | Misc | Prefix ->
+    false
+  | Libexec | Libexec_root | Bin | Sbin | Stublibs | Prefixexec -> true
 ;;

src/dune_rules/install_entry_with_site.ml

@@ -30,6 +30,8 @@ let make_with_site (section : Section_with_site.t) ?dst get_section ~kind src =
       | Share_root
       | Stublibs
       | Man
+      | Prefix
+      | Prefixexec
       | Misc -> section, dst
     in
     Entry.Unexpanded.make_with_dst section dst ~kind ~src

src/dune_rules/install_rules.ml

@@ -1436,14 +1436,31 @@ let gen_package_install_file_rules sctx (package : Package.t) =
             let toolchain = Context_name.to_string toolchain in
             Path.of_string (toolchain ^ "-sysroot")
           in
-          List.rev_map entries ~f:(fun (e : Install.Entry.Sourced.Expanded.t) ->
-            { e with
-              entry =
-                Install.Entry.Expanded.add_install_prefix
-                  e.entry
-                  ~paths:install_paths
-                  ~prefix
-            })
+          let parent_dir_hacked =
+            (* pre-opam 2.6, the best way to install an alternative sysroot
+               was to generate .install files with ../.., which was disallowed in opam 2.5.1 *)
+            List.rev_map entries ~f:(fun (e : Install.Entry.Sourced.Expanded.t) ->
+              { e with
+                entry =
+                  Install.Entry.Expanded.add_install_prefix
+                    e.entry
+                    ~paths:install_paths
+                    ~prefix
+              })
+          in
+          let prefix_entries =
+            (* opam 2.6+ supports a 'prefix' and 'prefixexec' key that allows us to directly specify this *)
+            List.rev_map entries ~f:(fun (e : Install.Entry.Sourced.Expanded.t) ->
+              { e with
+                entry =
+                  Install.Entry.Expanded.install_in_sysroot
+                    e.entry
+                    ~paths:install_paths
+                    ~prefix
+              })
+          in
+          (* generating both is fine, since any given version of opam will only recognize one or the other *)
+          parent_dir_hacked @ prefix_entries
       in
       if not (Package.allow_empty package)
       then

src/dune_rules/setup.defaults.ml

@@ -9,6 +9,7 @@ let roots : string option Install.Roots.t =
   ; bin = None
   ; sbin = None
   ; libexec_root = None
+  ; prefix = None
   }
 
 let prefix : string option = None

src/install/entry.ml

@@ -215,6 +215,22 @@ module Expanded = struct
     { t with dst = Dst.explicit dst }
   ;;
 
+  let install_in_sysroot t ~paths ~prefix =
+    let i_want_to_install_the_file_as =
+      relative_installed_path t ~paths
+      |> Path.as_in_source_tree_exn
+      |> Path.append_source prefix
+    in
+    let dst = Path.to_string i_want_to_install_the_file_as in
+    { t with
+      dst = Dst.explicit dst
+    ; section =
+        (if Section.should_set_executable_bit t.section
+         then Section.Prefixexec
+         else Section.Prefix)
+    }
+  ;;
+
   let of_install_file ~optional ~src ~dst ~section =
     { src
     ; section

src/install/entry.mli

@@ -34,6 +34,7 @@ module Expanded : sig
 
   val set_src : _ t -> 'src -> 'src t
   val add_install_prefix : 'src t -> paths:Path.t Paths.t -> prefix:Path.t -> 'src t
+  val install_in_sysroot : 'src t -> paths:Path.t Paths.t -> prefix:Path.t -> 'src t
   val gen_install_file : Path.t t list -> string
   val load_install_file : Path.t -> (Path.Local.t -> Path.t) -> Path.t t list
 end