diff --git a/src/dune_pkg/dependency_formula.ml b/src/dune_pkg/dependency_formula.ml index 9b66ea156aa..a66e6dc8a0c 100644 --- a/src/dune_pkg/dependency_formula.ml +++ b/src/dune_pkg/dependency_formula.ml @@ -33,50 +33,6 @@ let rec remove_packages v pkgs = Or (l, r) ;; -let rec is_post_filter filter = - match (filter : OpamTypes.filter) with - | FBool _ -> false - | FString _ -> false - | FIdent (_, var, _) -> - (match OpamVariable.to_string var with - | "post" -> true - | _ -> false) - | FOp (l, _relop, r) -> is_post_filter l || is_post_filter r - | FAnd (l, r) | FOr (l, r) -> is_post_filter l || is_post_filter r - | FNot filter -> not (is_post_filter filter) - | FDefined filter -> is_post_filter filter - | FUndef filter -> not (is_post_filter filter) -;; - -let is_post_foc filter_or_constraint = - match (filter_or_constraint : OpamTypes.filter OpamTypes.filter_or_constraint) with - | Filter filter -> is_post_filter filter - | Constraint _ -> false -;; - -let is_post condition = - condition |> OpamFormula.formula_to_cnf |> List.exists ~f:(List.exists ~f:is_post_foc) -;; - -let reachable_dependencies v = - let rec loop v = - match (v : OpamTypes.filtered_formula) with - | Empty -> Package_name.Set.empty - | Atom (name, condition) -> - (match is_post condition with - | true -> Package_name.Set.empty - | false -> - let name = name |> OpamPackage.Name.to_string |> Package_name.of_string in - Package_name.Set.singleton name) - | Block b -> loop b - | And (l, r) | Or (l, r) -> - let l = loop l in - let r = loop r in - Package_name.Set.union l r - in - loop v -;; - let rec any_package_name v = match (v : OpamTypes.filtered_formula) with | Empty -> None diff --git a/src/dune_pkg/dependency_formula.mli b/src/dune_pkg/dependency_formula.mli index 885b6aa0e37..073e9289242 100644 --- a/src/dune_pkg/dependency_formula.mli +++ b/src/dune_pkg/dependency_formula.mli @@ -26,7 +26,3 @@ val has_entries : t -> bool (** Returns the [Package_name.t] of a dependency from the formula, if it exists. *) val any_package_name : t -> Package_name.t option - -(** Returns all dependency names that can be found in the formula, no matter - whether they can be satisfied or not *) -val reachable_dependencies : t -> Package_name.Set.t diff --git a/src/dune_pkg/opam_solver.ml b/src/dune_pkg/opam_solver.ml index 1074337c240..b8edb8f9610 100644 --- a/src/dune_pkg/opam_solver.ml +++ b/src/dune_pkg/opam_solver.ml @@ -783,8 +783,21 @@ let reject_unreachable_packages = loop roots; !seen in - fun ~local_packages ~pkgs_by_name -> + fun solver_env ~local_packages ~pkgs_by_name -> let roots = Package_name.Map.keys local_packages in + let pkgs_by_version = + Package_name.Map.merge pkgs_by_name local_packages ~f:(fun name lhs rhs -> + match lhs, rhs with + | None, None -> assert false + | Some _, Some _ -> + Code_error.raise + "package is both local and returned by solver" + [ "name", Package_name.to_dyn name ] + | Some (lock_dir_pkg : Lock_dir.Pkg.t), None -> Some lock_dir_pkg.info.version + | None, Some _pkg -> + let version = Package_version.of_string "dev" in + Some version) + in let pkgs_by_name = Package_name.Map.merge pkgs_by_name local_packages ~f:(fun name lhs rhs -> match lhs, rhs with @@ -795,10 +808,28 @@ let reject_unreachable_packages = [ "name", Package_name.to_dyn name ] | Some (pkg : Lock_dir.Pkg.t), None -> Some (List.map pkg.depends ~f:snd) | None, Some (pkg : Local_package.For_solver.t) -> + let formula = pkg.dependencies |> Dependency_formula.to_filtered_formula in + (* Use `dev` because at this point we don't have any version *) + let opam_package = + OpamPackage.of_string (sprintf "%s.dev" (Package_name.to_string pkg.name)) + in + let env = add_self_to_filter_env opam_package (Solver_env.to_env solver_env) in + let resolved = + Resolve_opam_formula.filtered_formula_to_package_names + env + ~with_test:true + pkgs_by_version + formula + in let deps = - pkg.dependencies - |> Dependency_formula.reachable_dependencies - |> Package_name.Set.to_list + match resolved with + | Ok { regular; post = _ } -> + (* discard post deps *) + regular + | Error _ -> + Code_error.raise + "can't find a valid solution for the dependencies" + [ "name", Package_name.to_dyn pkg.name ] in let depopts = List.filter_map pkg.depopts ~f:(fun (d : Package_dependency.t) -> @@ -914,7 +945,9 @@ let solve_lock_dir (Package_name.to_string name) (Package_name.to_string dep_name) ])); - let reachable = reject_unreachable_packages ~local_packages ~pkgs_by_name in + let reachable = + reject_unreachable_packages solver_env ~local_packages ~pkgs_by_name + in let pkgs_by_name = Package_name.Map.filteri pkgs_by_name ~f:(fun name _ -> Package_name.Set.mem reachable name)