diff --git a/CHANGES.md b/CHANGES.md index 59e536ff80f..4b729722abf 100644 --- a/CHANGES.md +++ b/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) ------------------- diff --git a/bin/install_uninstall.ml b/bin/install_uninstall.ml index eb01d78e559..c0160dd27ce 100644 --- a/bin/install_uninstall.ml +++ b/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 diff --git a/test/blackbox-tests/dune.inc b/test/blackbox-tests/dune.inc index fe098f8684e..ab08aefe47b 100644 --- a/test/blackbox-tests/dune.inc +++ b/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) diff --git a/test/blackbox-tests/test-cases/github2228/run.t b/test/blackbox-tests/test-cases/github2228/run.t index 0b4413fbf65..8286741f278 100644 --- a/test/blackbox-tests/test-cases/github2228/run.t +++ b/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 diff --git a/test/blackbox-tests/test-cases/install-partial-package/dune b/test/blackbox-tests/test-cases/install-partial-package/dune new file mode 100644 index 00000000000..83f7df357e6 --- /dev/null +++ b/test/blackbox-tests/test-cases/install-partial-package/dune @@ -0,0 +1,2 @@ +(executable + (public_name foo)) diff --git a/test/blackbox-tests/test-cases/install-partial-package/dune-project b/test/blackbox-tests/test-cases/install-partial-package/dune-project new file mode 100644 index 00000000000..ae4dc54de2e --- /dev/null +++ b/test/blackbox-tests/test-cases/install-partial-package/dune-project @@ -0,0 +1,4 @@ +(lang dune 1.10) + +(package + (name foo)) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/install-partial-package/foo.ml b/test/blackbox-tests/test-cases/install-partial-package/foo.ml new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/install-partial-package/run.t b/test/blackbox-tests/test-cases/install-partial-package/run.t new file mode 100644 index 00000000000..7632d1fffb3 --- /dev/null +++ b/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]