diff --git a/src/client/opamListCommand.ml b/src/client/opamListCommand.ml index 232a30d6563..d7c56e93a91 100644 --- a/src/client/opamListCommand.ml +++ b/src/client/opamListCommand.ml @@ -348,7 +348,7 @@ let apply_selector ~base st = function base | Tag t -> OpamPackage.Set.filter (fun nv -> - get_opam st nv |> List.mem t @* OpamFile.OPAM.tags) + get_opam st nv |> List.exists (String.equal t) @* OpamFile.OPAM.tags) base | From_repository repos -> let rt = st.switch_repos in @@ -358,7 +358,8 @@ let apply_selector ~base st = function let packages = OpamPackage.keys (OpamRepositoryName.Map.find r rt.repo_opams) in - if List.mem r repos then OpamPackage.Set.union packages (aux rl) + if List.exists (OpamRepositoryName.equal r) repos + then OpamPackage.Set.union packages (aux rl) else OpamPackage.Set.diff (aux rl) packages in aux (OpamSwitchState.repos_list st) @@ -383,13 +384,16 @@ let apply_selector ~base st = function OpamStd.String.Map.exists (fun f -> function | OpamDirTrack.Removed -> false - | _ -> rel_name = f) + | _ -> rel_name = (f : string)) changes) (OpamFilename.files (OpamPath.Switch.install_dir root switch)) in let selections = - if switch = st.switch then OpamSwitchState.selections st - else OpamSwitchState.load_selections st.switch_global switch + if OpamSwitch.equal switch st.switch then + OpamSwitchState.selections st + else + OpamSwitchState.load_selections ~lock_kind:`Lock_none + st.switch_global switch in List.fold_left (fun acc f -> let name = @@ -502,7 +506,7 @@ let field_of_string ~raw = try OpamStd.List.assoc String.equal s names_fields with Not_found -> - match OpamStd.List.find_opt (fun x -> s = x) opam_fields with + match OpamStd.List.find_opt (fun x -> s = (x : string)) opam_fields with | Some f -> Field f | None -> OpamConsole.error_and_exit `Bad_arguments "No printer for %S" s @@ -567,7 +571,10 @@ let detail_printer ?prettify ?normalise ?(sort=false) st nv = (match OpamPinned.package_opt st nv.name with | Some nv -> let opam = get_opam st nv in - if Some opam = OpamPackage.Map.find_opt nv st.repos_package_index then + if + OpamStd.Option.equal OpamFile.OPAM.equal + (Some opam) (OpamPackage.Map.find_opt nv st.repos_package_index) + then Printf.sprintf "pinned to version %s" (OpamPackage.Version.to_string nv.version % [`blue]) else diff --git a/src/client/opamSwitchCommand.ml b/src/client/opamSwitchCommand.ml index de1254e093c..f3b2f10d4b4 100644 --- a/src/client/opamSwitchCommand.ml +++ b/src/client/opamSwitchCommand.ml @@ -528,7 +528,10 @@ let import_t ?ask ?(deps_only=false) importfile t = opam) pinned; (* Save new pinnings *) - let sel = OpamSwitchState.load_selections t.switch_global t.switch in + let sel = + OpamSwitchState.load_selections ~lock_kind:`Lock_write + t.switch_global t.switch + in S.write (OpamPath.Switch.selections t.switch_global.root t.switch) { sel with sel_pinned = pinned } diff --git a/src/state/opamGlobalState.ml b/src/state/opamGlobalState.ml index b647416cdfa..e51ec9f13a1 100644 --- a/src/state/opamGlobalState.ml +++ b/src/state/opamGlobalState.ml @@ -190,7 +190,7 @@ let drop gt = let _ = unlock gt in () let with_write_lock ?dontblock gt f = - if OpamStateConfig.is_newer_than_self gt then + if OpamStateConfig.is_newer_than_self ~lock_kind:`Lock_write gt then OpamConsole.error_and_exit `Locked "The opam root has been upgraded by a newer version of opam-state \ and cannot be written to"; diff --git a/src/state/opamRepositoryState.ml b/src/state/opamRepositoryState.ml index b7e8ff69a64..316d41c887a 100644 --- a/src/state/opamRepositoryState.ml +++ b/src/state/opamRepositoryState.ml @@ -159,7 +159,7 @@ let load lock_kind gt = log "LOAD-REPOSITORY-STATE %@ %a" (slog OpamFilename.Dir.to_string) gt.root; let lock = OpamFilename.flock lock_kind (OpamPath.repos_lock gt.root) in let repos_map = OpamStateConfig.Repos.safe_read ~lock_kind gt in - if OpamStateConfig.is_newer_than_self gt then + if OpamStateConfig.is_newer_than_self ~lock_kind:`Lock_write gt then log "root version (%s) is greater than running binary's (%s); \ load with best-effort (read-only)" (OpamVersion.to_string (OpamFile.Config.opam_root_version gt.config)) @@ -260,7 +260,8 @@ let drop ?cleanup rt = let _ = unlock ?cleanup rt in () let with_write_lock ?dontblock rt f = - if OpamStateConfig.is_newer_than_self rt.repos_global then + if OpamStateConfig.is_newer_than_self ~lock_kind:`Lock_write rt.repos_global + then OpamConsole.error_and_exit `Locked "The opam root has been upgraded by a newer version of opam-state \ and cannot be written to"; diff --git a/src/state/opamStateConfig.ml b/src/state/opamStateConfig.ml index 5b612481ce8..12fdbe028cc 100644 --- a/src/state/opamStateConfig.ml +++ b/src/state/opamStateConfig.ml @@ -246,21 +246,21 @@ let is_newer config = (** none -> shouldn't load (write attempt in readonly) Some true -> everything is fine normal read Some false -> readonly accorded, load with best effort *) -let is_readonly_opamroot_raw ?(lock_kind=`Lock_write) version = +let is_readonly_opamroot_raw ~lock_kind version = let newer = is_newer_raw version in let write = lock_kind = `Lock_write in if newer && write then None else Some (newer && not write) -let is_readonly_opamroot_t ?lock_kind gt = - is_readonly_opamroot_raw ?lock_kind +let is_readonly_opamroot_t ~lock_kind gt = + is_readonly_opamroot_raw ~lock_kind (Some (OpamFile.Config.opam_root_version gt.config)) -let is_newer_than_self ?lock_kind gt = - is_readonly_opamroot_t ?lock_kind gt <> Some false +let is_newer_than_self ~lock_kind gt = + is_readonly_opamroot_t ~lock_kind gt <> Some false -let load_if_possible_raw ?lock_kind root version (read,read_wo_err) f = - match is_readonly_opamroot_raw ?lock_kind version with +let load_if_possible_raw ~lock_kind root version (read,read_wo_err) f = + match is_readonly_opamroot_raw ~lock_kind version with | None -> OpamConsole.error_and_exit `Locked "Refusing write access to %s, which is more recent than this version of \ @@ -271,16 +271,16 @@ let load_if_possible_raw ?lock_kind root version (read,read_wo_err) f = | Some true -> read_wo_err f | Some false -> read f -let load_if_possible_t ?lock_kind opamroot config readf f = - load_if_possible_raw ?lock_kind +let load_if_possible_t ~lock_kind opamroot config readf f = + load_if_possible_raw ~lock_kind opamroot (Some (OpamFile.Config.opam_root_version config)) readf f -let load_if_possible ?lock_kind gt = - load_if_possible_t ?lock_kind gt.root gt.config +let load_if_possible ~lock_kind gt = + load_if_possible_t ~lock_kind gt.root gt.config -let load_config_root ?lock_kind readf opamroot = +let load_config_root ~lock_kind readf opamroot = let f = OpamPath.config opamroot in - load_if_possible_raw ?lock_kind + load_if_possible_raw ~lock_kind opamroot (OpamFile.Config.raw_root_version f) readf f @@ -289,42 +289,42 @@ let safe read read' default = let safe r f = OpamStd.Option.default default @@ r f in safe read, safe read' -let safe_load ?lock_kind opamroot = - load_config_root ?lock_kind +let safe_load ~lock_kind opamroot = + load_config_root ~lock_kind OpamFile.Config.(safe read_opt BestEffort.read_opt empty) opamroot -let load ?lock_kind opamroot = - load_config_root ?lock_kind +let load ~lock_kind opamroot = + load_config_root ~lock_kind OpamFile.Config.(read_opt, BestEffort.read_opt) opamroot (* switches *) module Switch = struct - let load_raw ?lock_kind root config readf switch = - load_if_possible_t ?lock_kind root config readf + let load_raw ~lock_kind root config readf switch = + load_if_possible_t ~lock_kind root config readf (OpamPath.Switch.switch_config root switch) - let safe_load_t ?lock_kind root switch = + let safe_load_t ~lock_kind root switch = let config = safe_load ~lock_kind:`Lock_read root in - load_raw ?lock_kind root config + load_raw ~lock_kind root config OpamFile.Switch_config.(safe read_opt BestEffort.read_opt empty) switch - let load ?lock_kind gt readf switch = - load_raw ?lock_kind gt.root gt.config readf switch + let load ~lock_kind gt readf switch = + load_raw ~lock_kind gt.root gt.config readf switch - let safe_load ?lock_kind gt switch = - load ?lock_kind gt + let safe_load ~lock_kind gt switch = + load ~lock_kind gt OpamFile.Switch_config.(safe read_opt BestEffort.read_opt empty) switch - let read_opt ?lock_kind gt switch = - load ?lock_kind gt + let read_opt ~lock_kind gt switch = + load ~lock_kind gt OpamFile.Switch_config.(read_opt, BestEffort.read_opt) switch - let safe_read_selections ?lock_kind gt switch = - load_if_possible ?lock_kind gt + let safe_read_selections ~lock_kind gt switch = + load_if_possible ~lock_kind gt OpamFile.SwitchSelections.(safe read_opt BestEffort.read_opt empty) (OpamPath.Switch.selections gt.root switch) @@ -332,8 +332,8 @@ end (* repos *) module Repos = struct - let safe_read ?lock_kind gt = - load_if_possible ?lock_kind gt + let safe_read ~lock_kind gt = + load_if_possible ~lock_kind gt OpamFile.Repos_config.(safe read_opt BestEffort.read_opt empty) (OpamPath.repos_config gt.root) end @@ -396,13 +396,13 @@ let get_current_switch_from_cwd root = with OpamPp.Bad_version _ -> None (* do we want `load_defaults` to fail / run a format upgrade ? *) -let load_defaults ?lock_kind root_dir = +let load_defaults ~lock_kind root_dir = let current_switch = match E.switch () with | Some "" | None -> get_current_switch_from_cwd root_dir | _ -> (* OPAMSWITCH is set, no need to lookup *) None in - match try load ?lock_kind root_dir with OpamPp.Bad_version _ -> None with + match try load ~lock_kind root_dir with OpamPp.Bad_version _ -> None with | None -> update ?current_switch (); None diff --git a/src/state/opamStateConfig.mli b/src/state/opamStateConfig.mli index c33379b6fa1..f45430ca832 100644 --- a/src/state/opamStateConfig.mli +++ b/src/state/opamStateConfig.mli @@ -92,8 +92,8 @@ val opamroot_with_provenance: ?root_dir:dirname -> unit -> provenance * dirname val opamroot: ?root_dir:dirname -> unit -> dirname (** Loads the global configuration file, protecting against concurrent writes *) -val load: ?lock_kind: 'a lock -> dirname -> OpamFile.Config.t option -val safe_load: ?lock_kind: 'a lock -> dirname -> OpamFile.Config.t +val load: lock_kind: 'a lock -> dirname -> OpamFile.Config.t option +val safe_load: lock_kind: 'a lock -> dirname -> OpamFile.Config.t (** Loads the config file from the OPAM root and updates default values for all related OpamXxxConfig modules. Doesn't read the env yet, the {!init} @@ -102,7 +102,7 @@ val safe_load: ?lock_kind: 'a lock -> dirname -> OpamFile.Config.t Returns the config file that was found, if any *) val load_defaults: - ?lock_kind:'a lock -> OpamFilename.Dir.t -> OpamFile.Config.t option + lock_kind:'a lock -> OpamFilename.Dir.t -> OpamFile.Config.t option (** Returns the current switch, failing with an error message is none is set. *) val get_switch: unit -> switch @@ -124,31 +124,31 @@ val resolve_local_switch: OpamFilename.Dir.t -> switch -> switch (** Given the required lock, returns [true] if the opam root is newer than the binary, so that it can only be loaded read-only by the current binary. *) -val is_newer_than_self: ?lock_kind:'a lock -> 'b global_state -> bool +val is_newer_than_self: lock_kind:'a lock -> 'b global_state -> bool (** Check config root version regarding self-defined one *) val is_newer: OpamFile.Config.t -> bool val load_config_root: - ?lock_kind:'a lock -> + lock_kind:'a lock -> ((OpamFile.Config.t OpamFile.t -> 'b) * (OpamFile.Config.t OpamFile.t -> 'b)) -> dirname -> 'b module Switch : sig val safe_load_t: - ?lock_kind: 'a lock -> dirname -> switch -> OpamFile.Switch_config.t + lock_kind: 'a lock -> dirname -> switch -> OpamFile.Switch_config.t val safe_load: - ?lock_kind: 'a lock -> 'b global_state -> switch -> OpamFile.Switch_config.t + lock_kind: 'a lock -> 'b global_state -> switch -> OpamFile.Switch_config.t val safe_read_selections: - ?lock_kind: 'a lock -> 'b global_state -> switch -> switch_selections + lock_kind: 'a lock -> 'b global_state -> switch -> switch_selections val read_opt: - ?lock_kind: 'a lock -> 'b global_state -> switch -> + lock_kind: 'a lock -> 'b global_state -> switch -> OpamFile.Switch_config.t option end module Repos : sig val safe_read: - ?lock_kind: 'a lock -> 'b global_state -> OpamFile.Repos_config.t + lock_kind: 'a lock -> 'b global_state -> OpamFile.Repos_config.t end (* Raw read an switch config to downgrade its [opam-version] from 2.1 to 2.0. diff --git a/src/state/opamSwitchState.ml b/src/state/opamSwitchState.ml index edcb09e5f46..0f5ed541e93 100644 --- a/src/state/opamSwitchState.ml +++ b/src/state/opamSwitchState.ml @@ -18,11 +18,11 @@ let slog = OpamConsole.slog open OpamStateTypes -let load_selections ?lock_kind gt switch = - OpamStateConfig.Switch.safe_read_selections ?lock_kind gt switch +let load_selections ~lock_kind gt switch = + OpamStateConfig.Switch.safe_read_selections ~lock_kind gt switch -let load_switch_config ?lock_kind gt switch = - match OpamStateConfig.Switch.read_opt ?lock_kind gt switch with +let load_switch_config ~lock_kind gt switch = + match OpamStateConfig.Switch.read_opt ~lock_kind gt switch with | Some c -> c | exception (OpamPp.Bad_version _ as e) -> OpamFormatUpgrade.hard_upgrade_from_2_1_intermediates @@ -257,7 +257,7 @@ let load lock_kind gt rt switch = OpamFilename.flock lock_kind (OpamPath.Switch.lock gt.root switch) in let switch_config = load_switch_config ~lock_kind gt switch in - if OpamStateConfig.is_newer_than_self gt then + if OpamStateConfig.is_newer_than_self ~lock_kind gt then log "root version (%s) is greater than running binary's (%s); \ load with best-effort (read-only)" (OpamVersion.to_string (OpamFile.Config.opam_root_version gt.config)) @@ -672,7 +672,8 @@ let drop st = let _ = unlock st in () let with_write_lock ?dontblock st f = - if OpamStateConfig.is_newer_than_self st.switch_global then + if OpamStateConfig.is_newer_than_self ~lock_kind:`Lock_write st.switch_global + then OpamConsole.error_and_exit `Locked "The opam root has been upgraded by a newer version of opam-state \ and cannot be written to"; diff --git a/src/state/opamSwitchState.mli b/src/state/opamSwitchState.mli index 5212ee662f4..2e3ff41f70a 100644 --- a/src/state/opamSwitchState.mli +++ b/src/state/opamSwitchState.mli @@ -45,7 +45,7 @@ val load_virtual: (** Load the switch's state file, without constructing the package maps: much faster than loading the full switch state *) val load_selections: - ?lock_kind: 'a lock -> 'b global_state -> switch -> switch_selections + lock_kind: 'a lock -> 'b global_state -> switch -> switch_selections (** Raw function to compute the availability of all packages, in [opams], given the switch configuration and the set of pinned packages. (The result is