Add check that all files are present before installing

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>

CHANGES.md

@@ -1,13 +1,17 @@
 unreleased
 ----------
 
-* Run `refmt` from the context's root directory. This improves error messages in
+- Run `refmt` from the context's root directory. This improves error messages in
   case of syntax errors. (#2223, @rgrinberg)
-  
+
 - In .merlin files, don't pass `-dump-ast` to the `future_syntax` preprocessor.
-  Merlin doesn't seem to like it when binary AST is generated by a `-pp` 
+  Merlin doesn't seem to like it when binary AST is generated by a `-pp`
   preprocessor. (#2236, @aalekseyev)
 
+- `dune install` will verify that all files mentioned in all .install files
+  exist before trying to install anything. This prevents partial installation of
+  packages (#2230, @rgrinberg)
+
 1.10.0 (30/05/2019)
 -------------------
 

bin/install_uninstall.ml

@@ -207,18 +207,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

test/blackbox-tests/dune.inc

@@ -849,6 +849,14 @@
    test-cases/install-libdir
    (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
+(alias
+ (name install-partial-package)
+ (deps (package dune) (source_tree test-cases/install-partial-package))
+ (action
+  (chdir
+   test-cases/install-partial-package
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+
 (alias
  (name install-rule-order)
  (deps (package dune) (source_tree test-cases/install-rule-order))
@@ -1596,6 +1604,7 @@
   (alias inline_tests)
   (alias install-dry-run)
   (alias install-libdir)
+  (alias install-partial-package)
   (alias install-rule-order)
   (alias install-with-var)
   (alias installable-dup-private-libs)
@@ -1770,6 +1779,7 @@
   (alias include-loop)
   (alias include-qualified)
   (alias inline_tests)
+  (alias install-partial-package)
   (alias install-rule-order)
   (alias install-with-var)
   (alias installable-dup-private-libs)

test/blackbox-tests/test-cases/github2228/run.t

@@ -15,7 +15,7 @@
   $ dune runtest
           test alias test/runtest
   testing
-  $ dune install --prefix ./installed 2>&1 | grep -v "line [0-9]\+"
+  $ dune install --prefix ./installed
   Installing installed/lib/foobar/META
   Installing installed/lib/foobar/dune-package
   Installing installed/lib/foobar/foobar$ext_lib

test/blackbox-tests/test-cases/install-partial-package/dune

@@ -0,0 +1,2 @@
+(executable
+ (public_name foo))

test/blackbox-tests/test-cases/install-partial-package/dune-project

@@ -0,0 +1,4 @@
+(lang dune 1.10)
+
+(package
+ (name foo))

test/blackbox-tests/test-cases/install-partial-package/run.t

@@ -0,0 +1,9 @@
+we do not proceed with installation if some files in the .install
+are missing.
+
+  $ dune build @install
+  $ rm -rf _build/install/default/bin
+  $ dune install
+  The following files which are listed in _build/default/foo.install cannot be installed because they do not exist:
+  - install/default/bin/foo
+  [1]