Add check that all files are present before installing

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
ocaml · Jun 3, 2019 · dce2745 · dce2745
1 parent 7bb311f
commit dce2745
Show file tree

Hide file tree

Showing 2 changed files with 54 additions and 24 deletions.
diff --git a/bin/install_uninstall.ml b/bin/install_uninstall.ml
@@ -54,6 +54,7 @@ module type FILE_OPERATIONS = sig
   val mkdir_p : Path.t -> unit
   val remove_if_exists : Path.t -> unit
   val remove_dir_if_empty : Path.t -> unit
+  val exists : Path.Build.t -> bool
 end
 
 module File_ops_dry_run : FILE_OPERATIONS = struct
@@ -81,6 +82,8 @@ module File_ops_dry_run : FILE_OPERATIONS = struct
       "Removing directory (if empty) %a\n"
       Path.pp
       path
+
+  let exists _ = true
 end
 
 module File_ops_real : FILE_OPERATIONS = struct
@@ -114,6 +117,8 @@ module File_ops_real : FILE_OPERATIONS = struct
       | _  -> ()
 
   let mkdir_p = Path.mkdir_p
+
+  let exists p = Path.exists (Path.build p)
 end
 
 let file_operations ~dry_run : (module FILE_OPERATIONS) =
@@ -207,18 +212,49 @@ let install_uninstall ~what =
        | _ -> ());
       let module CMap = Map.Make(Context) in
       let install_files_by_context =
-        CMap.of_list_multi install_files |> CMap.to_list
+        CMap.of_list_multi install_files
+        |> CMap.to_list
+        |> List.map ~f:(fun (context, install_files) ->
+          let entries_per_package =
+            Package.Name.Map.of_list_map_exn install_files
+              ~f:(fun (package, install_file) ->
+                let entries = Install.load_install_file install_file in
+                match
+                  List.filter_map entries ~f:(fun entry ->
+                    Option.some_if
+                      (not (Path.exists (Path.build entry.src)))
+                      entry.src)
+                with
+                | [] -> (package, entries)
+                | missing_files ->
+                  let pp =
+                    let open Pp in
+                    List.map missing_files ~f:(fun p ->
+                      concat
+                        [ verbatim "- "
+                        ; verbatim (Path.Build.to_string_maybe_quoted p)
+                        ]
+                    )
+                    |> concat ~sep:newline
+                  in
+                  die "The following files which are listed in %s cannot be \
+                       installed because they do not exist:@.%a@."
+                    (Path.to_string_maybe_quoted install_file)
+                    (fun fmt () -> Pp.pp fmt pp) ())
+          in
+          (context, entries_per_package))
       in
       let (module Ops) = file_operations ~dry_run in
       let files_deleted_in = ref Path.Set.empty in
       let+ () =
         Fiber.sequential_iter install_files_by_context
-          ~f:(fun (context, install_files) ->
+          ~f:(fun (context, entries_per_package) ->
             let+ (prefix, libdir) =
-              get_dirs context ~prefix_from_command_line ~libdir_from_command_line
+              get_dirs context ~prefix_from_command_line
+                ~libdir_from_command_line
             in
-            List.iter install_files ~f:(fun (package, path) ->
-              let entries = Install.load_install_file path in
+            entries_per_package 
+            |> Package.Name.Map.iteri ~f:(fun package entries ->
               let paths =
                 Install.Section.Paths.make
                   ~package

diff --git a/test/blackbox-tests/test-cases/github2228/run.t b/test/blackbox-tests/test-cases/github2228/run.t
@@ -15,22 +15,16 @@
   $ dune runtest
           test alias test/runtest
   testing
-  $ dune install --prefix ./installed 2>&1 | grep -v "line [0-9]\+"
-  Installing installed/lib/foobar/META
-  Installing installed/lib/foobar/dune-package
-  Installing installed/lib/foobar/foobar$ext_lib
-  Installing installed/lib/foobar/foobar.cma
-  Installing installed/lib/foobar/foobar.cmi
-  Installing installed/lib/foobar/foobar.cmti
-  Installing installed/lib/foobar/foobar.cmxa
-  Installing installed/lib/foobar/foobar.cmxs
-  Installing installed/lib/foobar/foobar.mli
-  Installing installed/lib/foobar/impl/foobar.cmi
-  Error: exception Sys_error("_build/install/default/lib/foobar/impl/foobar.cmi: No such file or directory")
-  Backtrace:
-
-  I must not segfault.  Uncertainty is the mind-killer.  Exceptions are
-  the little-death that brings total obliteration.  I will fully express
-  my cases.  Execution will pass over me and through me.  And when it
-  has gone past, I will unwind the stack along its path.  Where the
-  cases are handled there will be nothing.  Only I will remain.
+  $ dune install --prefix ./installed
+  The following files which are listed in _build/default/foobar.install cannot be installed because they do not exist:
+  - install/default/lib/foobar/impl/foobar.cmi
+  - install/default/lib/foobar/impl/foobar.cmt
+  - install/default/lib/foobar/impl/foobar.cmti
+  - install/default/lib/foobar/impl/foobar.cmx
+  - install/default/lib/foobar/impl/foobar.ml
+  - install/default/lib/foobar/impl/foobar.mli
+  - install/default/lib/foobar/impl/foobar_impl$ext_lib
+  - install/default/lib/foobar/impl/foobar_impl.cma
+  - install/default/lib/foobar/impl/foobar_impl.cmxa
+  - install/default/lib/foobar/impl/foobar_impl.cmxs
+  [1]