Merge pull request #6122 from kit-ty-kate/install-check-recursive

Make "opam install --check" check if all dependencies are installed recursively

master_changes.md

@@ -34,6 +34,8 @@ users)
   * [BUG] Fix `opam install --deps-only` set direct dependencies as root packages [#6125 @rjbou]
   * [BUG] Fix `opam install --check pkg` when pkg depends on a non-existing package [#6121 @kit-ty-kate]
   * Disable shallow clone by default except for opam repositories [#6146 @kit-ty-kate - fix #6145]
+  * Improve performance of `opam install --check` [#6122 @kit-ty-kate]
+  * Make `opam install --check` check if all dependencies are installed recursively [#6122 @kit-ty-kate - fix #6097]
 
 ## Build (package)
   * ◈ Add `--verbose-on` option to enable verbose mode on specified package names [#5682 @desumn @rjbou]
@@ -171,6 +173,7 @@ users)
   * Add a package fetching test [#6146 @rjbou]
   * Add a test showing the behaviour of `opam switch list-available` [#6098 @kit-ty-kate]
   * Add a test for git packages with submodules [#6132 @kit-ty-kate]
+  * Add basic test for `install --check` [#6122 @rjbou]
 
 ### Engine
   * Add a test filtering mechanism [#6105 @Keryan-dev]
@@ -227,6 +230,7 @@ users)
   * Add `OpamTypesBase.switch_selections_{compare,equal}`: proper comparison functions for `OpamTypes.switch_selections` [#6102 @kit-ty-kate]
   * `OpamFormula`: add `exists` [#5317 @kit-ty-kate]
   * `OpamTypes.universe`: make `u_available` and `u_attrs` lazy to speedup actions that do not require availiblity information [#5317 @kit-ty-kate - fix #5314]
+  * `OpamFormula`: add some missing comparison functions for `relop`, `version_constraint` and `atom` (`compare_relop`, `compare_version_constraint` and `compare_atom` respectively) [#6122 @kit-ty-kate]
 
 ## opam-core
   * `OpamStd.Env`: add `env_string_list` for parsing string list environment variables (comma separated) [#5682 @desumn]

src/client/opamClient.ml

@@ -1944,12 +1944,7 @@ let init
     ?dot_profile ?update_config ?env_hook ~completion shell;
   gt, rt, default_compiler
 
-let check_installed ~build ~post t atoms =
-  let available = (Lazy.force t.available_packages) in
-  let pkgs =
-    OpamPackage.to_map
-      (OpamFormula.packages_of_atoms available atoms)
-  in
+let check_installed ~build ~post ~recursive t atoms =
   let test = OpamStateConfig.(!r.build_test) in
   let doc = OpamStateConfig.(!r.build_doc) in
   let dev_setup = OpamStateConfig.(!r.dev_setup) in
@@ -1962,62 +1957,109 @@ let check_installed ~build ~post t atoms =
     | None -> OpamPackageVar.resolve_switch ~package t var
     | Some _ -> content
   in
-  OpamPackage.Name.Map.fold (fun name versions map ->
-      let compliant, missing_opt =
-        OpamPackage.Version.Set.fold (fun version (found, missing) ->
-            if found then (found, missing)
-            else
-            let pkg = OpamPackage.create name version in
-            let cnf_formula =
-              OpamSwitchState.opam t pkg
-              |> OpamFile.OPAM.depends
-              |> OpamFilter.filter_formula ~default:false (env pkg)
-              |> OpamFormula.to_cnf
+  let pkg_version_map = OpamPackage.to_map t.packages in
+  let module SeenSet = Set.Make (struct
+      type t = OpamFormula.atom
+      let compare = OpamFormula.compare_atom
+    end)
+  in
+  let rec loop map seen atoms =
+    List.fold_left (fun (map, seen) atom ->
+        if SeenSet.mem atom seen then
+          (* This is required for things like post-dependencies *)
+          (map, seen)
+        else
+          let seen = SeenSet.add atom seen in
+          let pkgname = fst atom in
+          let _found, missing_opt =
+            match OpamPackage.Name.Map.find_opt pkgname pkg_version_map with
+            | None -> (false, None)
+            | Some versions ->
+              OpamPackage.Version.Set.fold (fun version (found, missing) ->
+                  let pkg = OpamPackage.create pkgname version in
+                  if found || not (OpamFormula.check atom pkg) then
+                    (found, missing)
+                  else
+                    let cnf_formula =
+                      OpamSwitchState.opam t pkg
+                      |> OpamFile.OPAM.depends
+                      |> OpamFilter.filter_formula ~default:false (env pkg)
+                      |> OpamFormula.to_cnf
+                    in
+                    let rec get_found_and_missing found_conj missing_conj =
+                      function
+                      | [] -> (found_conj, missing_conj)
+                      | disj::xs ->
+                        let installed_conj =
+                          List.find_opt (fun ((n,_vc) as atom) ->
+                              OpamPackage.Set.exists
+                                (fun p -> OpamFormula.check atom p)
+                                (OpamPackage.packages_of_name t.installed n))
+                            disj
+                        in
+                        match installed_conj with
+                        | Some conj ->
+                          get_found_and_missing (conj :: found_conj)
+                            missing_conj xs
+                        | None ->
+                          (* TODO: maybe it would be nice to display
+                             disjunctions correctly in the output instead of
+                             transforming everything into one big conjunction *)
+                          get_found_and_missing found_conj
+                            (disj @ missing_conj) xs
+                    in
+                    let (found_conj, missing_conj) =
+                      get_found_and_missing [] [] cnf_formula
+                    in
+                    (missing_conj = [], Some (missing_conj, found_conj)))
+                versions (false, None)
+          in
+          match missing_opt with
+          | None ->
+            (* No version *)
+            OpamPackage.Name.Map.add pkgname
+              (OpamPackage.Name.Set.singleton pkgname)
+              map,
+            seen
+          | Some (missing_conj, found_conj) ->
+            let missing_set =
+              List.fold_left (fun names (name, _) ->
+                  OpamPackage.Name.Set.add name names)
+                OpamPackage.Name.Set.empty missing_conj
             in
-            let missing_conj =
-              List.filter
-                (List.for_all (fun ((n,_vc) as atom) ->
-                     OpamPackage.Set.for_all
-                       (fun p -> not (OpamFormula.check atom p))
-                       (OpamPackage.packages_of_name t.installed n)))
-                cnf_formula
+            let new_map =
+              if OpamPackage.Name.Set.is_empty missing_set
+              then map
+              else OpamPackage.Name.Map.add pkgname missing_set map
             in
-            if missing_conj = [] then true, None
-            else false, Some (pkg,missing_conj))
-          versions (false,None)
-      in
-      if compliant then map else
-      match missing_opt with
-      | None -> assert false (* version set can't be empty *)
-      | Some (pkg, missing_conj) ->
-        OpamPackage.Map.add pkg
-          (List.fold_left (fun names disj ->
-               List.fold_left (fun names (name, _) ->
-                   OpamPackage.Name.Set.add name names)
-                 names disj)
-              OpamPackage.Name.Set.empty missing_conj)
-          map
-    ) pkgs OpamPackage.Map.empty
+            if found_conj = [] || not recursive
+            then (new_map, seen)
+            else loop new_map seen found_conj
+      ) (map, seen) atoms
+  in
+  fst (loop OpamPackage.Name.Map.empty SeenSet.empty atoms)
 
 let assume_built_restrictions ?available_packages t atoms =
-  let missing = check_installed ~build:false ~post:false t atoms in
+  let missing =
+    check_installed ~build:false ~post:false ~recursive:false t atoms
+  in
   let atoms =
-    if OpamPackage.Map.is_empty missing then atoms else
+    if OpamPackage.Name.Map.is_empty missing then atoms else
       (OpamConsole.warning
          "You specified '--assume-built' but the following dependencies \
           aren't installed, skipping\n%s\
           Launch 'opam install %s --deps-only' (and recompile) to \
           install them.\n"
-         (OpamStd.Format.itemize (fun (nv, names) ->
-              Printf.sprintf "%s: %s" (OpamPackage.name_to_string nv)
+         (OpamStd.Format.itemize (fun (name, names) ->
+              Printf.sprintf "%s: %s" (OpamPackage.Name.to_string name)
                 (OpamStd.List.concat_map " " OpamPackage.Name.to_string
                    (OpamPackage.Name.Set.elements names)))
-             (OpamPackage.Map.bindings missing))
-         (OpamStd.List.concat_map " " OpamPackage.name_to_string
-            (OpamPackage.Map.keys missing));
+             (OpamPackage.Name.Map.bindings missing))
+         (OpamStd.List.concat_map " " OpamPackage.Name.to_string
+            (OpamPackage.Name.Map.keys missing));
        List.filter (fun (n,_) ->
-           not (OpamPackage.Map.exists (fun nv _ ->
-               OpamPackage.name nv = n) missing))
+           not (OpamPackage.Name.Map.exists (fun name _ ->
+               OpamPackage.Name.equal name n) missing))
          atoms)
   in
   let pinned =
@@ -2037,7 +2079,7 @@ let assume_built_restrictions ?available_packages t atoms =
     | None -> Lazy.force t.available_packages
   in
   let uninstalled_dependencies =
-    (OpamPackage.Map.values missing
+    (OpamPackage.Name.Map.values missing
      |> List.fold_left OpamPackage.Name.Set.union OpamPackage.Name.Set.empty
      |> OpamPackage.packages_of_names available_packages)
     -- installed_dependencies

src/client/opamClient.mli

@@ -72,10 +72,19 @@ val install_t:
   rw switch_state
 
 (** Check that the given list of packages [atoms] have their dependencies
-    satisfied, without calling the solver. Returns missing dependencies. *)
+    satisfied, without calling the solver.
+    Returns a map of package names to their set of missing dependencies.
+
+    @param recursive if [true] will check every installed dependencies
+    recursively. For example, this is useful if a package currently installed
+    has been modified and a dependencies has been added but that package has
+    not yet been upgraded.
+    Note: if [true], the keys of the resulting map might contain packages
+    further down the dependency tree and is no longer guaranteed to contain
+    only packages from [atoms]. *)
 val check_installed:
-  build:bool -> post:bool -> rw switch_state -> atom list ->
-  OpamPackage.Name.Set.t OpamPackage.Map.t
+  build:bool -> post:bool -> recursive:bool -> rw switch_state -> atom list ->
+  OpamPackage.Name.Set.t OpamPackage.Name.Map.t
 
 (** Reinstall the given set of packages. *)
 val reinstall:

src/client/opamCommands.ml

@@ -1875,8 +1875,9 @@ let install cli =
        OpamStd.Sys.exit_because `Success);
     if check then
        let missing =
-         OpamPackage.Map.fold (fun _ -> OpamPackage.Name.Set.union)
-           (OpamClient.check_installed ~build:true ~post:true st atoms)
+         OpamPackage.Name.Map.fold (fun _ -> OpamPackage.Name.Set.union)
+           (OpamClient.check_installed
+              ~build:true ~post:true ~recursive:true st atoms)
            (OpamPackage.Name.Set.empty)
        in
        if OpamPackage.Name.Set.is_empty missing then

src/format/opamFormula.ml

@@ -33,6 +33,19 @@ let string_of_atom = function
       (string_of_relop r)
       (OpamPackage.Version.to_string c)
 
+let compare_relop x y =
+  Stdlib.compare (x : [`Eq|`Neq|`Geq|`Gt|`Leq|`Lt]) (y : relop)
+
+let compare_version_constraint (relop1, v1) (relop2, v2) =
+  let cmp = compare_relop relop1 relop2 in
+  if cmp <> 0 then cmp
+  else OpamPackage.Version.compare v1 v2
+
+let compare_atom (name1, vc1) (name2, vc2) =
+  let cmp = OpamPackage.Name.compare name1 name2 in
+  if cmp <> 0 then cmp
+  else Option.compare compare_version_constraint vc1 vc2
+
 let short_string_of_atom = function
   | n, None       -> OpamPackage.Name.to_string n
   | n, Some (`Eq,c) ->

src/format/opamFormula.mli

@@ -15,12 +15,18 @@
 (** binary operations (compatible with the Dose type for Cudf operators!) *)
 type relop = OpamParserTypes.FullPos.relop_kind (* = [ `Eq | `Neq | `Geq | `Gt | `Leq | `Lt ] *)
 
+val compare_relop : relop -> relop -> int
+
 (** Version constraints for OPAM *)
 type version_constraint = relop * OpamPackage.Version.t
 
+val compare_version_constraint : version_constraint -> version_constraint -> int
+
 (** Formula atoms for OPAM *)
 type atom = OpamPackage.Name.t * version_constraint option
 
+val compare_atom : atom -> atom -> int
+
 (** Pretty-printing of atoms *)
 val string_of_atom: atom -> string