29716

Committed 20 Jan 2025 01:40PM UTC coverage: 6.926%. First build

Build # 29716

Build Type

Pull #11365

github

Committed by

web-flow

Commit Message

Merge dff61dc90 into 12010a06d

Pull Request Pull Request #11365: backport #11310: fix: package management working with ocaml.5.3.0

Coverage Stats

2 of 14 new or added lines in 2 files covered. (14.29%)

2957 of 42695 relevant lines covered (6.93%)

26682.01 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

7.35

/src/dune_rules/pkg_toolchain.ml

open Import
open Memo.O

let base_dir () =
  let cache_dir =
    Lazy.force Dune_util.xdg |> Xdg.cache_dir |> Path.Outside_build_dir.of_string
  in
  let path =
    Path.Outside_build_dir.relative
      (Path.Outside_build_dir.relative cache_dir "dune")
      "toolchains"
  in
  (let path = Path.outside_build_dir path in
   if not (Path.Untracked.exists path) then Path.mkdir_p path;
   if not (Path.Untracked.is_directory path)
   then
     User_error.raise
       [ Pp.textf "Expected %s to be a directory but it is not." (Path.to_string path) ]);
  path
;;

let pkg_dir (pkg : Dune_pkg.Lock_dir.Pkg.t) =
  (* The name of this package's directory within the toolchains
     directory. Includes a hash of some of the package's fields so that
     if a user modifies a package's lockfile in one project, then the
     modified package won't be used in other projects (unless the
     corresponding lockfile in those projects is modified in the same
     way). *)
  let dir_name =
    (* TODO should include resolved deps *)
    let pkg_hash = Digest.generic (Lock_dir.Pkg.remove_locs pkg) in
    (* A hash of the fields of a package that affect its installed artifacts *)
    sprintf
      "%s.%s-%s"
      (Package.Name.to_string pkg.info.name)
      (Package_version.to_string pkg.info.version)
      (Digest.to_string pkg_hash)
  in
  Path.Outside_build_dir.relative (base_dir ()) dir_name
;;

let installation_prefix ~pkg_dir = Path.Outside_build_dir.relative pkg_dir "target"

let is_compiler_and_toolchains_enabled name =
  match Config.get Compile_time.toolchains with
  | `Enabled ->
    let module Package_name = Dune_pkg.Package_name in
    let compiler_package_names =
      (* TODO don't hardcode these names here *)
      [ Package_name.of_string "ocaml-base-compiler"
      ; Package_name.of_string "ocaml-variants"
      ; Package_name.of_string "ocaml-compiler"
        (* The [ocaml-compiler] package is required to include all the
           packages that might install a compiler, starting from ocaml.5.3.0.
        *)
      ]
    in
    List.mem compiler_package_names name ~equal:Package_name.equal
  | `Disabled -> false
;;

let ocaml context env ~bin_dir =
  let which prog =
    let path = Path.Outside_build_dir.relative bin_dir prog in
    let+ exists = Fs_memo.file_exists path in
    if exists then Some (Path.outside_build_dir path) else None
  in
  let get_ocaml_tool ~dir:_ prog = which prog in
  Ocaml_toolchain.make context ~which ~env ~get_ocaml_tool
;;

(* The path to the directory containing the artifacts within the
   temporary install directory. When installing with the DESTDIR
   variable, the absolute path to the final installation directory is
   concatenated to the value of DESTDIR. *)
let installation_prefix_within_tmp_install_dir ~installation_prefix:prefix tmp_install_dir
  =
  let target_without_root_prefix =
    (* Remove the root directory prefix from the target directory so
       it can be used to create a path relative to the temporary
       install dir. *)
    match
      String.drop_prefix
        (Path.Outside_build_dir.to_string prefix)
        ~prefix:(Path.External.to_string Path.External.root)
    with
    | Some x -> x
    | None ->
      Code_error.raise
        "Expected prefix to start with root"
        [ "prefix", Path.Outside_build_dir.to_dyn prefix
        ; "root", Path.External.to_dyn Path.External.root
        ]
  in
  Path.relative tmp_install_dir target_without_root_prefix
;;

let modify_install_action (action : Dune_lang.Action.t) ~installation_prefix ~suffix =
  match action with
  | Run [ Literal make; Literal install ] ->
    (match String_with_vars.pform_only make, String_with_vars.text_only install with
     | Some (Pform.Var Pform.Var.Make), Some "install" ->
       let tmp_install_dir = Temp.create Dir ~prefix:"dune-toolchain-destdir" ~suffix in
       let action =
         (* Set the DESTDIR variable so installed artifacts are not immediately
            placed in the final installation directory. *)
         Dune_lang.Action.Run
           [ Literal make
           ; Literal install
           ; Slang.text (sprintf "DESTDIR=%s" (Path.to_string tmp_install_dir))
           ]
       in
       let prefix = Path.outside_build_dir installation_prefix in
       (* Append some commands to the install command that copy
          the artifacts to their final installation directory. *)
       Dune_lang.Action.Progn
         [ action
         ; Run
             [ Slang.text "mkdir"
             ; Slang.text "-p"
             ; Slang.text @@ Path.to_string @@ Path.parent_exn prefix
             ]
         ; Run
             [ Slang.text "mv"
             ; (* Prevents mv from replacing the destination if it
                  already exists. This can happen if two dune
                  instances race to install the toolchain. Note
                  that -n is not posix but it is supported by gnu
                  coreutils and by the default mv command on
                  macos, but not openbsd. *)
               Slang.text "-n"
             ; Slang.text
                 (Path.to_string
                  @@ installation_prefix_within_tmp_install_dir
                       ~installation_prefix
                       tmp_install_dir)
             ; Slang.text @@ Path.to_string @@ Path.parent_exn prefix
             ]
         ]
     | _ ->
       (* The install command is something other than `make install`, so don't
          attempt to modify. *)
       action)
  | _ ->
    (* Not a "run" action, so don't attempt to modify. *)
    action
;;

let modify_install_action ~prefix ~suffix action =
  let+ installed = Fs_memo.dir_exists prefix in
  if installed
  then
    (* Replace install command with no-op if the toolchain is already installed.
       TODO(steve): Move this check to action execution time *)
    Dune_lang.Action.Progn []
  else modify_install_action action ~installation_prefix:prefix ~suffix
;;

let touch file =
  Dune_lang.Action.Run
    [ Slang.text "touch"
    ; Slang.concat
        [ Slang.pform (Pform.Var (Pform.Var.Pkg Pform.Var.Pkg.Build)); Slang.text file ]
    ]
;;

(* Create an empty config.cache and config.status files so other packages see
   that the compiler package is installed.
   TODO: extract this from the .install *)
let touch_compiler_install =
  Dune_lang.Action.Progn [ touch "/config.cache"; touch "/config.status" ]
;;

let modify_build_action ~prefix action =
  let+ installed = Fs_memo.dir_exists prefix in
  if installed
  then
    (* If the toolchain is already installed, just create config.cache file.
       TODO(steve): Move this check to action execution time *)
    touch_compiler_install
  else action
;;

let install_roots ~prefix =
  Install.Roots.make prefix ~relative:Path.Outside_build_dir.relative
;;

1	open Import
2	open Memo.O
3
4	let base_dir () =
5	let cache_dir =	×
6	Lazy.force Dune_util.xdg \|> Xdg.cache_dir \|> Path.Outside_build_dir.of_string	×
7	in
8	let path =	×
9	Path.Outside_build_dir.relative
10	(Path.Outside_build_dir.relative cache_dir "dune")	×
11	"toolchains"
12	in
13	(let path = Path.outside_build_dir path in	×
14	if not (Path.Untracked.exists path) then Path.mkdir_p path;	×
15	if not (Path.Untracked.is_directory path)	×
16	then
17	User_error.raise	×
18	[ Pp.textf "Expected %s to be a directory but it is not." (Path.to_string path) ]);	×
19	path
20	;;
21
22	let pkg_dir (pkg : Dune_pkg.Lock_dir.Pkg.t) =
23	(* The name of this package's directory within the toolchains
24	directory. Includes a hash of some of the package's fields so that
25	if a user modifies a package's lockfile in one project, then the
26	modified package won't be used in other projects (unless the
27	corresponding lockfile in those projects is modified in the same
28	way). *)
29	let dir_name =	×
30	(* TODO should include resolved deps *)
31	let pkg_hash = Digest.generic (Lock_dir.Pkg.remove_locs pkg) in	×
32	(* A hash of the fields of a package that affect its installed artifacts *)
33	sprintf	×
34	"%s.%s-%s"
35	(Package.Name.to_string pkg.info.name)	×
36	(Package_version.to_string pkg.info.version)	×
37	(Digest.to_string pkg_hash)	×
38	in
39	Path.Outside_build_dir.relative (base_dir ()) dir_name	×
40	;;
41
42	let installation_prefix ~pkg_dir = Path.Outside_build_dir.relative pkg_dir "target"	×
43
44	let is_compiler_and_toolchains_enabled name =
45	match Config.get Compile_time.toolchains with	×
46	\| `Enabled ->	×
47	let module Package_name = Dune_pkg.Package_name in
48	let compiler_package_names =
49	(* TODO don't hardcode these names here *)
50	[ Package_name.of_string "ocaml-base-compiler"	×
51	; Package_name.of_string "ocaml-variants"	×
NEW 52	; Package_name.of_string "ocaml-compiler"	×
53	(* The [ocaml-compiler] package is required to include all the
54	packages that might install a compiler, starting from ocaml.5.3.0.
55	*)
56	]
57	in
58	List.mem compiler_package_names name ~equal:Package_name.equal
59	\| `Disabled -> false	×
60	;;
61
62	let ocaml context env ~bin_dir =
63	let which prog =	×
64	let path = Path.Outside_build_dir.relative bin_dir prog in	×
65	let+ exists = Fs_memo.file_exists path in	×
66	if exists then Some (Path.outside_build_dir path) else None	×
67	in
68	let get_ocaml_tool ~dir:_ prog = which prog in	×
69	Ocaml_toolchain.make context ~which ~env ~get_ocaml_tool
70	;;
71
72	(* The path to the directory containing the artifacts within the
73	temporary install directory. When installing with the DESTDIR
74	variable, the absolute path to the final installation directory is
75	concatenated to the value of DESTDIR. *)
76	let installation_prefix_within_tmp_install_dir ~installation_prefix:prefix tmp_install_dir
77	=
78	let target_without_root_prefix =	×
79	(* Remove the root directory prefix from the target directory so
80	it can be used to create a path relative to the temporary
81	install dir. *)
82	match
83	String.drop_prefix
84	(Path.Outside_build_dir.to_string prefix)	×
85	~prefix:(Path.External.to_string Path.External.root)	×
86	with
87	\| Some x -> x	×
88	\| None ->	×
89	Code_error.raise	×
90	"Expected prefix to start with root"
91	[ "prefix", Path.Outside_build_dir.to_dyn prefix	×
92	; "root", Path.External.to_dyn Path.External.root	×
93	]
94	in
95	Path.relative tmp_install_dir target_without_root_prefix
96	;;
97
98	let modify_install_action (action : Dune_lang.Action.t) ~installation_prefix ~suffix =
99	match action with	×
100	\| Run [ Literal make; Literal install ] ->	×
101	(match String_with_vars.pform_only make, String_with_vars.text_only install with	×
102	\| Some (Pform.Var Pform.Var.Make), Some "install" ->	×
103	let tmp_install_dir = Temp.create Dir ~prefix:"dune-toolchain-destdir" ~suffix in
104	let action =	×
105	(* Set the DESTDIR variable so installed artifacts are not immediately
106	placed in the final installation directory. *)
107	Dune_lang.Action.Run
108	[ Literal make
109	; Literal install
110	; Slang.text (sprintf "DESTDIR=%s" (Path.to_string tmp_install_dir))	×
111	]
112	in
113	let prefix = Path.outside_build_dir installation_prefix in
114	(* Append some commands to the install command that copy
115	the artifacts to their final installation directory. *)
116	Dune_lang.Action.Progn	×
117	[ action
118	; Run
119	[ Slang.text "mkdir"	×
120	; Slang.text "-p"	×
121	; Slang.text @@ Path.to_string @@ Path.parent_exn prefix	×
122	]
123	; Run
124	[ Slang.text "mv"	×
125	; (* Prevents mv from replacing the destination if it
126	already exists. This can happen if two dune
127	instances race to install the toolchain. Note
128	that -n is not posix but it is supported by gnu
129	coreutils and by the default mv command on
130	macos, but not openbsd. *)
131	Slang.text "-n"	×
132	; Slang.text	×
133	(Path.to_string	×
134	@@ installation_prefix_within_tmp_install_dir	×
135	~installation_prefix
136	tmp_install_dir)
137	; Slang.text @@ Path.to_string @@ Path.parent_exn prefix	×
138	]
139	]
140	\| _ ->	×
141	(* The install command is something other than `make install`, so don't
142	attempt to modify. *)
143	action)
144	\| _ ->	×
145	(* Not a "run" action, so don't attempt to modify. *)
146	action
147	;;
148
149	let modify_install_action ~prefix ~suffix action =
150	let+ installed = Fs_memo.dir_exists prefix in	×
151	if installed	×
152	then
153	(* Replace install command with no-op if the toolchain is already installed.
154	TODO(steve): Move this check to action execution time *)
155	Dune_lang.Action.Progn []	×
156	else modify_install_action action ~installation_prefix:prefix ~suffix	×
157	;;
158
159	let touch file =
160	Dune_lang.Action.Run	78✔
161	[ Slang.text "touch"	78✔
162	; Slang.concat	78✔
163	[ Slang.pform (Pform.Var (Pform.Var.Pkg Pform.Var.Pkg.Build)); Slang.text file ]	78✔
164	]
165	;;
166
167	(* Create an empty config.cache and config.status files so other packages see
168	that the compiler package is installed.
169	TODO: extract this from the .install *)
170	let touch_compiler_install =
171	Dune_lang.Action.Progn [ touch "/config.cache"; touch "/config.status" ]	39✔
172	;;
173
174	let modify_build_action ~prefix action =
175	let+ installed = Fs_memo.dir_exists prefix in	×
176	if installed	×
177	then
178	(* If the toolchain is already installed, just create config.cache file.
179	TODO(steve): Move this check to action execution time *)
NEW 180	touch_compiler_install	×
181	else action	×
182	;;
183
184	let install_roots ~prefix =
185	Install.Roots.make prefix ~relative:Path.Outside_build_dir.relative	×
186	;;

ocaml / dune / 29716

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous