Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
75 changes: 36 additions & 39 deletions bin/install_uninstall.ml
Original file line number Diff line number Diff line change
Expand Up @@ -641,46 +641,43 @@ let run
let (module Ops) = file_operations ~verbosity ~dry_run ~workspace in
let files_deleted_in = ref Path.Set.empty in
let+ () =
Fiber.sequential_iter
install_files_by_context
~f:(fun (context, entries_per_package) ->
let* roots = get_dirs context ~prefix_from_command_line ~from_command_line in
let conf = Artifact_substitution.Conf.of_install ~relocatable ~roots ~context in
Fiber.sequential_iter entries_per_package ~f:(fun (package, entries) ->
let+ entries =
(* CR rgrinberg: why don't we install things concurrently? *)
Fiber.sequential_map entries ~f:(fun entry ->
let dst =
let paths = Install.Paths.make ~relative:Path.relative ~package ~roots in
Install.Entry.relative_installed_path entry ~paths
|> interpret_destdir ~destdir
in
let dir = Path.parent_exn dst in
match what with
| Uninstall ->
Ops.remove_file_if_exists dst;
files_deleted_in := Path.Set.add !files_deleted_in dir;
Fiber.return entry
| Install ->
install_entry
~ops:(module Ops)
~conf
~package
~dir
~create_install_files
~dst
~verbosity
entry)
in
if create_install_files
then (
let fn =
resolve_package_install
workspace
~findlib_toolchain:(Context.findlib_toolchain context)
package
Fiber.parallel_iter install_files_by_context ~f:(fun (context, entries_per_package) ->
let* roots = get_dirs context ~prefix_from_command_line ~from_command_line in
let conf = Artifact_substitution.Conf.of_install ~relocatable ~roots ~context in
Fiber.parallel_iter entries_per_package ~f:(fun (package, entries) ->
let+ entries =
Fiber.parallel_map entries ~f:(fun entry ->
let dst =
let paths = Install.Paths.make ~relative:Path.relative ~package ~roots in
Install.Entry.relative_installed_path entry ~paths
|> interpret_destdir ~destdir
in
Install.Entry.gen_install_file entries |> Io.write_file (Path.source fn))))
let dir = Path.parent_exn dst in
match what with
| Uninstall ->
Ops.remove_file_if_exists dst;
files_deleted_in := Path.Set.add !files_deleted_in dir;
Fiber.return entry
| Install ->
install_entry
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think this function prints. So we need to delay printing until everything is installed to maintain deterministic order

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The removal operations also print. I'm assuming what we should do here is:

  • collect all the operations we try to perform
  • sort them, print them in order

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Sure that sounds fine. Though you don't necessarily need to sort, if you just preserve the order we have now, that would also be good enough.

~ops:(module Ops)
~conf
~package
~dir
~create_install_files
~dst
~verbosity
entry)
in
if create_install_files
then (
let fn =
resolve_package_install
workspace
~findlib_toolchain:(Context.findlib_toolchain context)
package
in
Install.Entry.gen_install_file entries |> Io.write_file (Path.source fn))))
in
Path.Set.to_list !files_deleted_in
(* This [List.rev] is to ensure we process children directories before
Expand Down
25 changes: 25 additions & 0 deletions test/blackbox-tests/test-cases/install/cmxs_exec.t
Original file line number Diff line number Diff line change
Expand Up @@ -60,6 +60,13 @@ Test the error message if a destination is a non-empty directory instead of a fi
Installing prefix/lib/foo/META
Installing prefix/lib/foo/dune-package
Error: Please delete non-empty directory prefix/lib/foo/foo.a manually.
Installing prefix/lib/foo/foo.cma
Installing prefix/lib/foo/foo.cmi
Installing prefix/lib/foo/foo.cmt
Installing prefix/lib/foo/foo.cmx
Installing prefix/lib/foo/foo.cmxa
Installing prefix/lib/foo/foo.ml
Installing prefix/lib/foo/foo.cmxs
[1]

Test the error message if a destination is a file instead of a directory.
Expand All @@ -69,4 +76,22 @@ Test the error message if a destination is a file instead of a directory.
$ dune install --prefix prefix --display short
Installing prefix/lib/foo/META
Error: Please delete file prefix/lib/foo manually.
Installing prefix/lib/foo/dune-package
Error: Please delete file prefix/lib/foo manually.
Installing prefix/lib/foo/foo.a
Error: Please delete file prefix/lib/foo manually.
Installing prefix/lib/foo/foo.cma
Error: Please delete file prefix/lib/foo manually.
Installing prefix/lib/foo/foo.cmi
Error: Please delete file prefix/lib/foo manually.
Installing prefix/lib/foo/foo.cmt
Error: Please delete file prefix/lib/foo manually.
Installing prefix/lib/foo/foo.cmx
Error: Please delete file prefix/lib/foo manually.
Installing prefix/lib/foo/foo.cmxa
Error: Please delete file prefix/lib/foo manually.
Installing prefix/lib/foo/foo.ml
Error: Please delete file prefix/lib/foo manually.
Installing prefix/lib/foo/foo.cmxs
Error: Please delete file prefix/lib/foo manually.
[1]
Loading