From 61ab7b3483fb0132e0d6bb11ef5aa4af17be53fe Mon Sep 17 00:00:00 2001 From: Thomas Gazagnaire Date: Fri, 27 Oct 2023 12:14:50 +0200 Subject: [PATCH 1/6] Add a test for pin packages --- lib/opam_solve.ml | 29 ++++++++++++-- lib/opam_solve.mli | 3 +- test/lib/dune | 2 +- test/lib/test_duniverse_lib.ml | 4 ++ test/lib/test_solve.ml | 72 ++++++++++++++++++++++++++-------- 5 files changed, 89 insertions(+), 21 deletions(-) diff --git a/lib/opam_solve.ml b/lib/opam_solve.ml index 57607c724..525945601 100644 --- a/lib/opam_solve.ml +++ b/lib/opam_solve.ml @@ -757,7 +757,9 @@ module Local_opam_context : BASE_CONTEXT with type input = switch = struct end module Mock_context : - BASE_CONTEXT with type input = opam_env * OpamFile.OPAM.t list = struct + BASE_CONTEXT + with type input = opam_env * OpamFile.OPAM.t list * OpamPackage.t list = +struct type rejection = UserConstraint of OpamFormula.atom let pp_rejection f = function @@ -817,10 +819,31 @@ module Mock_context : (v, Error (UserConstraint (name, Some test))) | _ -> (v, Ok pkg)) - type input = opam_env * OpamFile.OPAM.t list + type input = opam_env * OpamFile.OPAM.t list * OpamPackage.t list - let create ?(test = OpamPackage.Name.Set.empty) ~constraints (env, pkgs) = + let create ?(test = OpamPackage.Name.Set.empty) ~constraints (env, pkgs, pins) + = let env varname = String.Map.find_opt varname env in + let pins = OpamPackage.Set.of_list pins in + (* remove pinned packages from the universe -- as that's what's the + opam solver is doing. *) + let pp_pkg ppf pkg = + Fmt.pf ppf "%s.%s" + (OpamPackage.Name.to_string (OpamFile.OPAM.name pkg)) + (OpamPackage.Version.to_string (OpamFile.OPAM.version pkg)) + in + let pkgs = + List.filter pkgs ~f:(fun pkg -> + let keep = + match + OpamPackage.package_of_name_opt pins (OpamFile.OPAM.name pkg) + with + | None -> true + | Some pin -> OpamFile.OPAM.version pkg = OpamPackage.version pin + in + Logs.debug (fun l -> l "keep %a = %b" pp_pkg pkg keep); + keep) + in { pkgs; constraints; test; env } end diff --git a/lib/opam_solve.mli b/lib/opam_solve.mli index 6ea90801e..566bafaac 100644 --- a/lib/opam_solve.mli +++ b/lib/opam_solve.mli @@ -13,7 +13,8 @@ val local_opam_config_solver : (switch, switch_diagnostics) t val explicit_repos_solver : (opam_env * explicit_repos, explicit_repos_diagnostics) t -val mock_solver : (opam_env * OpamFile.OPAM.t list, mock_diagnostics) t +val mock_solver : + (opam_env * OpamFile.OPAM.t list * OpamPackage.t list, mock_diagnostics) t val calculate : build_only:bool -> diff --git a/test/lib/dune b/test/lib/dune index d1154744c..50a9fe1c3 100644 --- a/test/lib/dune +++ b/test/lib/dune @@ -1,5 +1,5 @@ (test (name test_duniverse_lib) - (libraries alcotest duniverse_lib) + (libraries alcotest duniverse_lib logs.fmt) (action (run %{test} -e))) diff --git a/test/lib/test_duniverse_lib.ml b/test/lib/test_duniverse_lib.ml index eb9cb2a4a..84f632cfb 100644 --- a/test/lib/test_duniverse_lib.ml +++ b/test/lib/test_duniverse_lib.ml @@ -1,3 +1,7 @@ +let () = + Logs.set_level (Some Logs.Debug); + Logs.set_reporter (Logs_fmt.reporter ()) + let () = Alcotest.run "Duniverse" [ diff --git a/test/lib/test_solve.ml b/test/lib/test_solve.ml index 0add1d542..574ffd1cc 100644 --- a/test/lib/test_solve.ml +++ b/test/lib/test_solve.ml @@ -1,4 +1,4 @@ -let calculate universe root expected = +let calculate universe ?(pins = []) root expected = let preferred_versions = OpamPackage.Name.Map.empty in let local_opam_files = OpamPackage.Name.Map.empty in let target_packages = @@ -12,7 +12,7 @@ let calculate universe root expected = match Duniverse_lib.Opam_solve.calculate ~build_only:false ~allow_jbuilder:false ~require_cross_compile:false ~preferred_versions ~local_opam_files - ~target_packages ~opam_provided ~pin_depends solver (opam_env, pkgs) + ~target_packages ~opam_provided ~pin_depends solver (opam_env, pkgs, pins) with | Ok es -> let es = @@ -151,59 +151,98 @@ depends: ["p1" "p2"] calculate universe root [ ("ocaml-base-compiler", "3.14"); ("p1", "1"); ("p2", "1"); ("root", "0") ] -let conflict_url () = - let universe = - List.map OpamFile.OPAM.read_from_string - [ - {| +let universe_with_url = + List.map OpamFile.OPAM.read_from_string + [ + {| opam-version: "2.0" name: "ocaml-base-compiler" version: "3.14" |}; - {| + {| opam-version: "2.0" name: "p1" version: "1" dev-repo: "x" url { src: "https://p.com/p.tbz" - checksum: "sha256=0000000000000000000000000000000000000000000000000000000000000003" + checksum: "sha256=0000000000000000000000000000000000000000000000000000000000000001" } |}; - {| + {| opam-version: "2.0" name: "p1" version: "2" dev-repo: "x" url { src: "https://p.com/p.tbz" - checksum: "sha256=0000000000000000000000000000000000000000000000000000000000000042" + checksum: "sha256=0000000000000000000000000000000000000000000000000000000000000002" } |}; - {| + {| opam-version: "2.0" name: "p2" version: "1" dev-repo: "x" url { src: "https://p.com/p.tbz" - checksum: "sha256=0000000000000000000000000000000000000000000000000000000000000003" + checksum: "sha256=0000000000000000000000000000000000000000000000000000000000000001" } |}; - ] - in + {| +opam-version: "2.0" +name: "p2" +version: "2" +dev-repo: "x" +url { + src: "https://p.com/p.tbz" + checksum: "sha256=0000000000000000000000000000000000000000000000000000000000000002" +} +|}; + ] + +let conflict_url () = + let universe = universe_with_url in let root = OpamFile.OPAM.read_from_string {| opam-version: "2.0" name: "root" version: "0" -depends: ["p1" "p2"] +depends: ["p1" {= "1"} "p2"] |} in calculate universe root [ ("ocaml-base-compiler", "3.14"); ("p1", "1"); ("p2", "1"); ("root", "0") ] +let no_conflict_with_pin () = + let p2_dev = + OpamFile.OPAM.read_from_string + {| +opam-version: "2.0" +name: "p2" +version: "0" +dev-repo: "x" +url { + src: "git+https://x#hash" +} +|} + in + let universe = p2_dev :: universe_with_url in + let root = + OpamFile.OPAM.read_from_string + {| +opam-version: "2.0" +name: "root" +version: "0" +depends: ["p1" "p2"] +|} + in + calculate + ~pins:[ OpamPackage.of_string "p2.0" ] + universe root + [ ("ocaml-base-compiler", "3.14"); ("p1", "2"); ("p2", "0"); ("root", "0") ] + let suite = ( "solve", [ @@ -211,4 +250,5 @@ let suite = Alcotest.test_case "conflicts" `Quick conflicts; Alcotest.test_case "conflict_class" `Quick conflict_class; Alcotest.test_case "conflict_url" `Quick conflict_url; + Alcotest.test_case "no_conflict_with_pin" `Quick no_conflict_with_pin; ] ) From 2c51556e26a7dfc89765e78d956c7c057fecf88f Mon Sep 17 00:00:00 2001 From: Thomas Gazagnaire Date: Fri, 27 Oct 2023 15:11:02 +0200 Subject: [PATCH 2/6] Better support for pinned packages Co-authored-by: @reynir --- lib/duniverse.ml | 74 +++++++++++++---- lib/duniverse.mli | 1 + lib/opam.ml | 11 ++- lib/opam.mli | 3 +- lib/opam_solve.ml | 159 +++++++++++++++++++++---------------- test/lib/test_duniverse.ml | 11 ++- 6 files changed, 163 insertions(+), 96 deletions(-) diff --git a/lib/duniverse.ml b/lib/duniverse.ml index 6e8c64cd9..68f950050 100644 --- a/lib/duniverse.ml +++ b/lib/duniverse.ml @@ -67,6 +67,7 @@ module Repo = struct dev_repo : Dev_repo.t; url : unresolved Url.t; hashes : OpamHash.t list; + pinned : bool; } let equal t t' = @@ -74,12 +75,13 @@ module Repo = struct && Dev_repo.equal t.dev_repo t'.dev_repo && Url.equal Git.Ref.equal t.url t'.url - let pp fmt { opam; dev_repo; url; hashes } = + let pp fmt { opam; dev_repo; url; hashes; pinned } = let open Pp_combinators.Ocaml in Format.fprintf fmt - "@[{ opam = %a;@ dev_repo = %a;@ url = %a;@ hashes = %a }@]" + "@[{ opam = %a;@ dev_repo = %a;@ url = %a;@ hashes = %a;@ \ + pinned = %b; }@]" Opam.Pp.raw_package opam string dev_repo (Url.pp Git.Ref.pp) url - (list Opam.Pp.hash) hashes + (list Opam.Pp.hash) hashes pinned let from_package_summary ~get_default_branch ps = let open Opam.Package_summary in @@ -101,10 +103,11 @@ module Repo = struct package; dev_repo = Some dev_repo; hashes; + pinned; _; } -> let* url = url url_src in - Ok (Some { opam = package; dev_repo; url; hashes }) + Ok (Some { opam = package; dev_repo; url; hashes; pinned }) | { dev_repo = None; package; _ } -> Logs.warn (fun l -> l @@ -113,6 +116,8 @@ module Repo = struct Opam.Pp.package package); Ok None | _ -> Ok None) + + let is_pinned { pinned; _ } = pinned end type 'ref t = { @@ -132,6 +137,27 @@ module Repo = struct Dev_repo.repo_name dev_repo |> Base.Result.map ~f:(function "dune" -> "dune_" | name -> name) + let log_url_selection ~dev_repo ~packages pinned_packages = + let url_to_string : unresolved Url.t -> string = function + | Git { repo; ref } -> Printf.sprintf "%s#%s" repo ref + | Other s -> s + in + let pp_package fmt { Package.opam = { name; version }; url; _ } = + Format.fprintf fmt "%a.%a: %s" Opam.Pp.package_name name Opam.Pp.version + version (url_to_string url) + in + let sep fmt () = Format.fprintf fmt "\n" in + Logs.warn (fun l -> + l + "The following packages come from the same repository %s but are \ + associated with different URLs:\n\ + %a\n\ + The url for the pinned package(s) was selected: %a" + (Dev_repo.to_string dev_repo) + (Fmt.list ~sep pp_package) packages + Fmt.(list ~sep pp_package) + pinned_packages) + let from_packages ~dev_repo (packages : Package.t list) = let open Result.O in let provided_packages = List.map packages ~f:(fun p -> p.Package.opam) in @@ -145,19 +171,33 @@ module Repo = struct in match urls with | [ (url, hashes) ] -> Ok { dir; url; hashes; provided_packages } - | _ -> - let pp_hash = Fmt.of_to_string OpamHash.to_string in - (* this should not happen because we passed extra constraints - to the opam solver to avoid this situation *) - Fmt.failwith - "The following packages have the same `dev-repo' but are using \ - different versions of the archive tarballs:\n\ - %a\n\ - This should not happen, please report the issue to \ - https://github.com/tarides/opam-monorepo.\n\ - %!" - Fmt.Dump.(list (pair (Url.pp string) (list pp_hash))) - urls + | _ -> ( + match List.filter ~f:Package.is_pinned packages with + | [] -> + let pp_hash = Fmt.of_to_string OpamHash.to_string in + (* this should not happen because we passed extra constraints + to the opam solver to avoid this situation *) + Fmt.failwith + "The following packages have the same `dev-repo' but are using \ + different versions of the archive tarballs:\n\ + %a\n\ + This should not happen, please report the issue to \ + https://github.com/tarides/opam-monorepo.\n\ + %!" + Fmt.Dump.(list (pair (Url.pp string) (list pp_hash))) + urls + | pinned :: pinneds -> + if + not + (List.for_all pinneds ~f:(fun p -> + String.equal pinned.Package.dev_repo p.Package.dev_repo + && (* not necessary? *) + Url.equal Git.Ref.equal pinned.url p.url)) + then failwith "multiple pinned packages for same dir"; + log_url_selection ~dev_repo ~packages (pinned :: pinneds); + let url = pinned.url in + let hashes = pinned.hashes in + Ok { dir; url; hashes; provided_packages }) let equal equal_ref t t' = let { dir; url; hashes; provided_packages } = t in diff --git a/lib/duniverse.mli b/lib/duniverse.mli index 7e3a125f1..8a22c05ed 100644 --- a/lib/duniverse.mli +++ b/lib/duniverse.mli @@ -37,6 +37,7 @@ module Repo : sig dev_repo : string; url : unresolved Url.t; hashes : OpamHash.t list; + pinned : bool; } val equal : t -> t -> bool diff --git a/lib/opam.ml b/lib/opam.ml index 488b5da1d..e8c19124e 100644 --- a/lib/opam.ml +++ b/lib/opam.ml @@ -195,6 +195,7 @@ module Package_summary = struct hashes : OpamHash.t list; dev_repo : string option; depexts : (OpamSysPkg.Set.t * OpamTypes.filter) list; + pinned : bool; flags : Package_flag.t list; has_build_commands : bool; has_install_commands : bool; @@ -207,6 +208,7 @@ module Package_summary = struct hashes; dev_repo; depexts; + pinned; flags; has_build_commands; has_install_commands; @@ -214,16 +216,16 @@ module Package_summary = struct let open Pp_combinators.Ocaml in Format.fprintf fmt "@[{ name = %a;@ version = %a;@ url_src = %a;@ hashes = %a;@ \ - dev_repo = %a;@ depexts = %a;@ flags = %a;@ has_build_commands = %B;@ \ - has_install_commands = %B}@]" + dev_repo = %a;@ depexts = %a;@ pinned = %b;@ flags = %a;@ \ + has_build_commands = %B;@ has_install_commands = %B}@]" Pp.package_name package.name Pp.version package.version (option ~brackets:true Url.pp) url_src (list Hash.pp) hashes (option ~brackets:true string) - dev_repo Depexts.pp depexts (list Package_flag.pp) flags + dev_repo Depexts.pp depexts pinned (list Package_flag.pp) flags has_build_commands has_install_commands - let from_opam package opam_file = + let from_opam package ~pinned opam_file = let url_field = OpamFile.OPAM.url opam_file in let url_src = Base.Option.map ~f:Url.from_opam_field url_field in let hashes = @@ -245,6 +247,7 @@ module Package_summary = struct hashes; dev_repo; depexts; + pinned; flags; has_build_commands; has_install_commands; diff --git a/lib/opam.mli b/lib/opam.mli index 4e3fce7b3..88fc21c86 100644 --- a/lib/opam.mli +++ b/lib/opam.mli @@ -20,13 +20,14 @@ module Package_summary : sig hashes : OpamHash.t list; dev_repo : string option; depexts : (OpamSysPkg.Set.t * OpamTypes.filter) list; + pinned : bool; flags : OpamTypes.package_flag list; has_build_commands : bool; has_install_commands : bool; } val pp : t Fmt.t - val from_opam : OpamPackage.t -> OpamFile.OPAM.t -> t + val from_opam : OpamPackage.t -> pinned:bool -> OpamFile.OPAM.t -> t val is_safe_package : t -> bool (** A package is safe when it is clear that it can be added to the lockfile diff --git a/lib/opam_solve.ml b/lib/opam_solve.ml index 525945601..24be53c59 100644 --- a/lib/opam_solve.ml +++ b/lib/opam_solve.ml @@ -5,6 +5,8 @@ module type BASE_CONTEXT = sig type input + val is_pinned : t -> OpamTypes.name -> bool + val create : ?test:OpamPackage.Name.Set.t -> constraints:OpamFormula.version_constraint OpamTypes.name_map -> @@ -19,6 +21,8 @@ module type OPAM_MONOREPO_CONTEXT = sig include Opam_0install.S.CONTEXT with type rejection = r + val is_pinned : t -> OpamTypes.name -> bool + val create : ?install_test_deps_for:OpamPackage.Name.Set.t -> ?opam_provided:OpamPackage.Name.Set.t -> @@ -56,6 +60,10 @@ module Opam_monorepo_context (Base_context : BASE_CONTEXT) : preferred_versions : OpamTypes.version OpamPackage.Name.Map.t; } + let is_pinned { base_context; fixed_packages; _ } name = + Base_context.is_pinned base_context name + || OpamPackage.Name.Map.mem name fixed_packages + type r = | Non_dune | No_cross_compile @@ -85,8 +93,9 @@ module Opam_monorepo_context (Base_context : BASE_CONTEXT) : preferred_versions; } - let validate_candidate ~allow_jbuilder ~must_cross_compile ~require_dune ~name - ~version opam_file = + let validate_candidate + { allow_jbuilder; require_cross_compile; require_dune; _ } ~name ~version + opam_file = (* this function gets called way too often.. memoize? *) let pkg = OpamPackage.create name version in let depends = OpamFile.OPAM.depends opam_file in @@ -95,14 +104,17 @@ module Opam_monorepo_context (Base_context : BASE_CONTEXT) : Opam.depends_on_dune ~allow_jbuilder depends || Opam.depends_on_dune ~allow_jbuilder depopts in - let summary = Opam.Package_summary.from_opam pkg opam_file in + (* is_safe_package doesn't care about ~pinned, so we use a dummy + value here. *) + let summary = Opam.Package_summary.from_opam pkg ~pinned:false opam_file in let is_valid_dune_wise = Opam.Package_summary.is_safe_package summary || (not require_dune) || uses_dune in match is_valid_dune_wise with | false -> Error Non_dune - | true when (not must_cross_compile) || Opam.has_cross_compile_tag opam_file + | true + when (not require_cross_compile) || Opam.has_cross_compile_tag opam_file -> Ok opam_file | true -> Error No_cross_compile @@ -139,17 +151,13 @@ module Opam_monorepo_context (Base_context : BASE_CONTEXT) : let depends = remove_opam_provided_from_formula opam_provided depends in OpamFile.OPAM.with_depends depends opam_file - let filter_candidates ~allow_jbuilder ~must_cross_compile ~require_dune ~name - versions = + let filter_candidates t name versions = List.map ~f:(fun (version, result) -> match result with | Error r -> (version, Error (Base_rejection r)) | Ok opam_file -> - let res = - validate_candidate ~allow_jbuilder ~must_cross_compile - ~require_dune ~name ~version opam_file - in + let res = validate_candidate t ~name ~version opam_file in (version, res)) versions @@ -208,9 +216,7 @@ module Opam_monorepo_context (Base_context : BASE_CONTEXT) : let hashes pkg = match OpamFile.OPAM.url pkg with | None -> [] - | Some url -> - (* note: pinned packages do not have any checksums set *) - OpamFile.URL.checksum url + | Some url -> OpamFile.URL.checksum url (* build the list of conflicts by removing packages with the same hash *) let conflicts_with_same_dev_repo_but_a_different_hash = @@ -235,78 +241,74 @@ module Opam_monorepo_context (Base_context : BASE_CONTEXT) : Hashtbl.add memo (name, version) r; r - let with_conflict pkg = - let name = OpamFile.OPAM.name pkg in - let version = OpamFile.OPAM.version pkg in - let hashes = hashes pkg in - let entry = (name, version, hashes) in - match OpamFile.OPAM.dev_repo pkg with - | None -> pkg - | Some dev_repo -> - let dev_repo = Dev_repo.from_string (OpamUrl.to_string dev_repo) in - let in_conflicts = - match Dev_repo.Tbl.find_all dev_repos dev_repo with - | [] -> - Dev_repo.Tbl.add dev_repos dev_repo entry; - [] - | conflicts -> - if not (List.mem entry ~set:conflicts) then + let with_conflict t pkg = + if is_pinned t (OpamFile.OPAM.name pkg) then + (* skip conflicts if a package is in pin-depends, listed on the + CLI or pinned in the local switch. *) + pkg + else + let name = OpamFile.OPAM.name pkg in + let version = OpamFile.OPAM.version pkg in + let hashes = hashes pkg in + let entry = (name, version, hashes) in + match OpamFile.OPAM.dev_repo pkg with + | None -> pkg + | Some dev_repo -> + let dev_repo = Dev_repo.from_string (OpamUrl.to_string dev_repo) in + let in_conflicts = + match Dev_repo.Tbl.find_all dev_repos dev_repo with + | [] -> Dev_repo.Tbl.add dev_repos dev_repo entry; - (* remove packages from the same repo *) - conflicts_with_same_dev_repo_but_a_different_hash entry conflicts - in - let conflicts = - in_conflicts - |> List.map ~f:(fun (name, version, _) -> - let version = - let open OpamTypes in - let v = OpamPackage.Version.to_string version in - OpamFormula.Atom (Constraint (`Eq, FString v)) - in - OpamFormula.Atom (name, version)) - |> OpamFormula.ors - in - OpamFile.OPAM.with_conflicts conflicts pkg + [] + | conflicts -> + if not (List.mem entry ~set:conflicts) then + Dev_repo.Tbl.add dev_repos dev_repo entry; + (* remove packages from the same repo *) + conflicts_with_same_dev_repo_but_a_different_hash entry + conflicts + in + let conflicts = + in_conflicts + |> List.map ~f:(fun (name, version, _) -> + let version = + let open OpamTypes in + let v = OpamPackage.Version.to_string version in + OpamFormula.Atom (Constraint (`Eq, FString v)) + in + OpamFormula.Atom (name, version)) + |> OpamFormula.ors + in + OpamFile.OPAM.with_conflicts conflicts pkg - let add_url_conflicts pkgs = + let add_url_conflicts t pkgs = List.map ~f:(fun (v, pkg) -> match pkg with | Error _ -> (v, pkg) - | Ok pkg -> (v, Ok (with_conflict pkg))) + | Ok pkg -> (v, Ok (with_conflict t pkg))) pkgs - let candidates - { - base_context; - fixed_packages; - allow_jbuilder; - require_dune; - opam_provided; - require_cross_compile; - preferred_versions; - } name = - match OpamPackage.Name.Map.find_opt name fixed_packages with + let candidates t name = + match OpamPackage.Name.Map.find_opt name t.fixed_packages with | Some (version, opam_file) -> let opam_file = - remove_opam_provided_from_dependencies opam_provided opam_file + remove_opam_provided_from_dependencies t.opam_provided opam_file in [ (version, Ok opam_file) ] | None -> - let candidates = Base_context.candidates base_context name in - let must_cross_compile = - require_cross_compile + let candidates = Base_context.candidates t.base_context name in + let require_cross_compile = + t.require_cross_compile && List.exists ~f:candidate_cross_compile candidates in let preferred_version = - OpamPackage.Name.Map.find_opt name preferred_versions + OpamPackage.Name.Map.find_opt name t.preferred_versions in - filter_candidates ~allow_jbuilder ~must_cross_compile ~require_dune - ~name candidates - |> remove_opam_provided ~opam_provided + filter_candidates { t with require_cross_compile } name candidates + |> remove_opam_provided ~opam_provided:t.opam_provided |> demote_candidates_to_avoid |> promote_version preferred_version - |> add_url_conflicts + |> add_url_conflicts t let user_restrictions { base_context; _ } name = Base_context.user_restrictions base_context name @@ -621,8 +623,9 @@ module Make_solver (Context : OPAM_MONOREPO_CONTEXT) : let get_opam_info ~context { package; vendored } = match Context.opam_file context package with | Ok opam_file -> + let pinned = Context.is_pinned context package.name in let package_summary = - Opam.Package_summary.from_opam package opam_file + Opam.Package_summary.from_opam package opam_file ~pinned in Opam.Dependency_entry.{ package_summary; vendored } | Error (`Msg msg) -> @@ -706,6 +709,8 @@ module Multi_dir_context : type nonrec t = t list + let is_pinned _ _ = false + (** Create a Dir_context with multiple repos. The list is ordered by priority. First repo in the list as higher priority. If two repos provide the same version of a package, the one from the highest priority repo will be used, the other @@ -750,10 +755,21 @@ end module Local_opam_context : BASE_CONTEXT with type input = switch = struct include Opam_0install.Switch_context + type t = { + context : Opam_0install.Switch_context.t; + state : OpamStateTypes.unlocked OpamStateTypes.switch_state; + } + type input = OpamStateTypes.unlocked OpamStateTypes.switch_state - let create ?test ~constraints switch_state = - create ?test ~constraints switch_state + let is_pinned t pkg = OpamSwitchState.is_pinned t.state pkg + let candidates t = candidates t.context + let user_restrictions t = user_restrictions t.context + let filter_deps t = filter_deps t.context + + let create ?test ~constraints state = + let context = create ?test ~constraints state in + { context; state } end module Mock_context : @@ -770,6 +786,7 @@ struct type t = { env : string -> OpamVariable.variable_contents option; pkgs : OpamFile.OPAM.t list; + pins : OpamPackage.Set.t; constraints : OpamFormula.version_constraint OpamTypes.name_map; test : OpamPackage.Name.Set.t; } @@ -821,6 +838,8 @@ struct type input = opam_env * OpamFile.OPAM.t list * OpamPackage.t list + let is_pinned t name = OpamPackage.has_name t.pins name + let create ?(test = OpamPackage.Name.Set.empty) ~constraints (env, pkgs, pins) = let env varname = String.Map.find_opt varname env in @@ -844,7 +863,7 @@ struct Logs.debug (fun l -> l "keep %a = %b" pp_pkg pkg keep); keep) in - { pkgs; constraints; test; env } + { pkgs; constraints; test; env; pins } end (* The code below aims to provide a unified interface over the two solver diff --git a/test/lib/test_duniverse.ml b/test/lib/test_duniverse.ml index dfda0a7fc..07655c8cd 100644 --- a/test/lib/test_duniverse.ml +++ b/test/lib/test_duniverse.ml @@ -28,8 +28,8 @@ let opam_factory ~name ~version = OpamPackage.create name version let summary_factory ?(name = "undefined") ?(version = "1") ?dev_repo ?url_src - ?(hashes = []) ?(depexts = []) ?(flags = []) ?(has_build_commands = false) - ?(has_install_commands = false) () = + ?(hashes = []) ?(depexts = []) ?(pinned = false) ?(flags = []) + ?(has_build_commands = false) ?(has_install_commands = false) () = let package = opam_factory ~name ~version in { Opam.Package_summary.package; @@ -37,6 +37,7 @@ let summary_factory ?(name = "undefined") ?(version = "1") ?dev_repo ?url_src url_src; hashes; depexts; + pinned; flags; has_build_commands; has_install_commands; @@ -82,6 +83,7 @@ module Repo = struct dev_repo = "d"; url = Other "u"; hashes = []; + pinned = false; }) in [ @@ -126,16 +128,17 @@ module Repo = struct dev_repo = "d"; url = Git { repo = "r"; ref = "master" }; hashes = []; + pinned = false; })) (); ] end let package_factory ?(name = "") ?(version = "") ?(dev_repo = "") - ?(url = Duniverse.Repo.Url.Other "") ?(hashes = []) () = + ?(url = Duniverse.Repo.Url.Other "") ?(hashes = []) ?(pinned = false) () = let open Duniverse.Repo.Package in let opam = opam_factory ~name ~version in - { opam; dev_repo; url; hashes } + { opam; dev_repo; url; hashes; pinned } let test_from_packages = let make_test ~name ~dev_repo ~packages ~expected () = From a0c00dfb629a68c4b106c285cbfdb952ddf1d1b6 Mon Sep 17 00:00:00 2001 From: Thomas Gazagnaire Date: Fri, 22 Sep 2023 16:29:31 +0200 Subject: [PATCH 3/6] Update CHANGES --- CHANGES.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 482984e3f..59b8e3554 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -7,6 +7,9 @@ ### Deprecated ### Fixed +- Fix support for pinned packages. In that case, it is not necessary to add + dev-repo conflicts as `opam-monorepo` will always use the pinned repository. + (#398, @samoht, reported by @emillon) ### Removed From 59c66b455f97d3ee58b08ffececb49d1ca6cde0d Mon Sep 17 00:00:00 2001 From: Thomas Gazagnaire Date: Tue, 7 Nov 2023 09:05:46 +0100 Subject: [PATCH 4/6] Update lib/duniverse.ml Co-authored-by: Marek Kubica --- lib/duniverse.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/duniverse.ml b/lib/duniverse.ml index 68f950050..9296dd8a1 100644 --- a/lib/duniverse.ml +++ b/lib/duniverse.ml @@ -152,7 +152,7 @@ module Repo = struct "The following packages come from the same repository %s but are \ associated with different URLs:\n\ %a\n\ - The url for the pinned package(s) was selected: %a" + The URL for the pinned package(s) was selected: %a" (Dev_repo.to_string dev_repo) (Fmt.list ~sep pp_package) packages Fmt.(list ~sep pp_package) From 83330adb938fd6e5ac9ca4701c976661cefaf5c1 Mon Sep 17 00:00:00 2001 From: Thomas Gazagnaire Date: Tue, 7 Nov 2023 17:45:57 +0100 Subject: [PATCH 5/6] Update CHANGES --- CHANGES.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGES.md b/CHANGES.md index 59b8e3554..67dd18aa8 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -9,7 +9,7 @@ ### Fixed - Fix support for pinned packages. In that case, it is not necessary to add dev-repo conflicts as `opam-monorepo` will always use the pinned repository. - (#398, @samoht, reported by @emillon) + (#398, #353, @samoht, @reynir, reported by @emillon) ### Removed From 7714da21346821bd2078fe7471f49ab6b0e25932 Mon Sep 17 00:00:00 2001 From: Thomas Gazagnaire Date: Tue, 7 Nov 2023 16:58:34 +0100 Subject: [PATCH 6/6] Update following Marek's review --- lib/duniverse.ml | 26 ++++++++------------------ lib/opam.ml | 2 +- lib/opam_solve.ml | 19 ++++++++++--------- test/lib/test_duniverse.ml | 25 ++++++++++++++----------- 4 files changed, 33 insertions(+), 39 deletions(-) diff --git a/lib/duniverse.ml b/lib/duniverse.ml index 9296dd8a1..7ab7ad81c 100644 --- a/lib/duniverse.ml +++ b/lib/duniverse.ml @@ -142,11 +142,10 @@ module Repo = struct | Git { repo; ref } -> Printf.sprintf "%s#%s" repo ref | Other s -> s in - let pp_package fmt { Package.opam = { name; version }; url; _ } = - Format.fprintf fmt "%a.%a: %s" Opam.Pp.package_name name Opam.Pp.version - version (url_to_string url) + let pp_package fmt { Package.opam; url; _ } = + Fmt.pf fmt "%a: %s" Opam.Pp.package opam (url_to_string url) in - let sep fmt () = Format.fprintf fmt "\n" in + let pp_packages = Fmt.(list ~sep:(any "\n") pp_package) in Logs.warn (fun l -> l "The following packages come from the same repository %s but are \ @@ -154,9 +153,7 @@ module Repo = struct %a\n\ The URL for the pinned package(s) was selected: %a" (Dev_repo.to_string dev_repo) - (Fmt.list ~sep pp_package) packages - Fmt.(list ~sep pp_package) - pinned_packages) + pp_packages packages pp_packages pinned_packages) let from_packages ~dev_repo (packages : Package.t list) = let open Result.O in @@ -186,17 +183,10 @@ module Repo = struct %!" Fmt.Dump.(list (pair (Url.pp string) (list pp_hash))) urls - | pinned :: pinneds -> - if - not - (List.for_all pinneds ~f:(fun p -> - String.equal pinned.Package.dev_repo p.Package.dev_repo - && (* not necessary? *) - Url.equal Git.Ref.equal pinned.url p.url)) - then failwith "multiple pinned packages for same dir"; - log_url_selection ~dev_repo ~packages (pinned :: pinneds); - let url = pinned.url in - let hashes = pinned.hashes in + | first_pin :: _ as pins -> + log_url_selection ~dev_repo ~packages pins; + let url = first_pin.url in + let hashes = first_pin.hashes in Ok { dir; url; hashes; provided_packages }) let equal equal_ref t t' = diff --git a/lib/opam.ml b/lib/opam.ml index e8c19124e..41d3d620d 100644 --- a/lib/opam.ml +++ b/lib/opam.ml @@ -216,7 +216,7 @@ module Package_summary = struct let open Pp_combinators.Ocaml in Format.fprintf fmt "@[{ name = %a;@ version = %a;@ url_src = %a;@ hashes = %a;@ \ - dev_repo = %a;@ depexts = %a;@ pinned = %b;@ flags = %a;@ \ + dev_repo = %a;@ depexts = %a;@ pinned = %B;@ flags = %a;@ \ has_build_commands = %B;@ has_install_commands = %B}@]" Pp.package_name package.name Pp.version package.version (option ~brackets:true Url.pp) diff --git a/lib/opam_solve.ml b/lib/opam_solve.ml index 24be53c59..1ca46bcd0 100644 --- a/lib/opam_solve.ml +++ b/lib/opam_solve.ml @@ -844,23 +844,24 @@ struct = let env varname = String.Map.find_opt varname env in let pins = OpamPackage.Set.of_list pins in + let pkg_of_opam pkg = + let name = OpamFile.OPAM.name pkg in + let version = OpamFile.OPAM.version pkg in + OpamPackage.create name version + in (* remove pinned packages from the universe -- as that's what's the opam solver is doing. *) - let pp_pkg ppf pkg = - Fmt.pf ppf "%s.%s" - (OpamPackage.Name.to_string (OpamFile.OPAM.name pkg)) - (OpamPackage.Version.to_string (OpamFile.OPAM.version pkg)) - in let pkgs = - List.filter pkgs ~f:(fun pkg -> + List.filter pkgs ~f:(fun opam -> + let pkg = pkg_of_opam opam in let keep = match - OpamPackage.package_of_name_opt pins (OpamFile.OPAM.name pkg) + OpamPackage.package_of_name_opt pins (OpamPackage.name pkg) with | None -> true - | Some pin -> OpamFile.OPAM.version pkg = OpamPackage.version pin + | Some pin -> OpamPackage.version pkg = OpamPackage.version pin in - Logs.debug (fun l -> l "keep %a = %b" pp_pkg pkg keep); + Logs.debug (fun l -> l "keep %a = %b" Opam.Pp.package pkg keep); keep) in { pkgs; constraints; test; env; pins } diff --git a/test/lib/test_duniverse.ml b/test/lib/test_duniverse.ml index 07655c8cd..54faab776 100644 --- a/test/lib/test_duniverse.ml +++ b/test/lib/test_duniverse.ml @@ -74,18 +74,18 @@ module Repo = struct summary_factory ~dev_repo:"d" ~url_src:(Other "u") ~name:"y" ~version:"v" ~hashes:[] ?has_build_commands ?has_install_commands in - let simple_package = - Ok - (Some - Duniverse.Repo.Package. - { - opam = opam_factory ~name:"y" ~version:"v"; - dev_repo = "d"; - url = Other "u"; - hashes = []; - pinned = false; - }) + let pkg = + Duniverse.Repo.Package. + { + opam = opam_factory ~name:"y" ~version:"v"; + dev_repo = "d"; + url = Other "u"; + hashes = []; + pinned = false; + } in + let simple_package = Ok (Some pkg) in + let pinned_package = Ok (Some { pkg with pinned = true }) in [ make_test ~name:"Base package" ~summary:(summary_factory ~name:"dune" ()) @@ -99,6 +99,9 @@ module Repo = struct make_test ~name:"Regular" ~summary:(simple_summary ~has_build_commands:true ()) ~expected:simple_package (); + make_test ~name:"pinned" + ~summary:(simple_summary ~has_build_commands:true ~pinned:true ()) + ~expected:pinned_package (); make_test ~name:"Has only install commands" ~summary:(simple_summary ~has_install_commands:true ()) ~expected:simple_package ();