From 1f032d462595e727a0d5786bee7f590b1d960b64 Mon Sep 17 00:00:00 2001
From: Antonio Nuno Monteiro <anmonteiro@gmail.com>
Date: Fri, 26 Dec 2025 12:43:03 -0800
Subject: [PATCH] fix: install entries concurrently

Signed-off-by: Antonio Nuno Monteiro <anmonteiro@gmail.com>
---
 bin/install_uninstall.ml                      | 75 +++++++++----------
 .../test-cases/install/cmxs_exec.t            | 25 +++++++
 2 files changed, 61 insertions(+), 39 deletions(-)

diff --git a/bin/install_uninstall.ml b/bin/install_uninstall.ml
index 1c5a6272474..4ca91583bcb 100644
--- a/bin/install_uninstall.ml
+++ b/bin/install_uninstall.ml
@@ -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
+                ~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
diff --git a/test/blackbox-tests/test-cases/install/cmxs_exec.t b/test/blackbox-tests/test-cases/install/cmxs_exec.t
index 8fef2d14331..3657a062d6a 100644
--- a/test/blackbox-tests/test-cases/install/cmxs_exec.t
+++ b/test/blackbox-tests/test-cases/install/cmxs_exec.t
@@ -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.
@@ -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]