From 80b80c423bf0df6ea5a12e68f8d74386dade0741 Mon Sep 17 00:00:00 2001 From: Louis Gesbert Date: Wed, 22 Nov 2017 10:24:41 +0100 Subject: [PATCH 1/7] Remove need for confirmation when overriding an existing pin --- src/client/opamPinCommand.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/client/opamPinCommand.ml b/src/client/opamPinCommand.ml index 7d0b817410f..add9857f9bd 100644 --- a/src/client/opamPinCommand.ml +++ b/src/client/opamPinCommand.ml @@ -398,12 +398,12 @@ and source_pin (if no_changes then "already" else "currently") (string_of_pinned cur_opam); if no_changes then () - else if OpamConsole.confirm "Proceed and change pinning target ?" then + else (* if OpamConsole.confirm "Proceed and change pinning target ?" then *) OpamFilename.remove (OpamFile.filename (OpamPath.Switch.Overlay.tmp_opam st.switch_global.root st.switch name)) - else raise Exns.Aborted; + (* else raise Exns.Aborted *); cur_version, cur_urlf with Not_found -> if OpamPackage.has_name st.compiler_packages name then ( From 9109ca62e16cdfb9bf68d3d1b1e23a88ed9f5e31 Mon Sep 17 00:00:00 2001 From: Louis Gesbert Date: Wed, 22 Nov 2017 10:45:08 +0100 Subject: [PATCH 2/7] Clarify the type of arguments for `remove|reinstall|upgrade DIR' raw opam filenames aren't allowed in these cases --- src/client/opamArg.ml | 19 +++++++++++++++++++ src/client/opamArg.mli | 6 ++++++ src/client/opamAuxCommands.mli | 4 +--- src/client/opamCommands.ml | 6 +++--- 4 files changed, 29 insertions(+), 6 deletions(-) diff --git a/src/client/opamArg.ml b/src/client/opamArg.ml index 685bbe3219d..ddb5eb7d4bd 100644 --- a/src/client/opamArg.ml +++ b/src/client/opamArg.ml @@ -502,6 +502,18 @@ let atom_or_local = in parse, print +let atom_or_dir = + let parse str = match fst atom_or_local str with + | `Ok (`Filename _) -> + `Error (Printf.sprintf + "Not a valid package specification or existing directory: %s" + str) + | `Ok (`Atom _ | `Dirname _ as atom_or_dir) -> `Ok (atom_or_dir) + | `Error e -> `Error e + in + let print ppf = snd atom_or_local ppf in + parse, print + let variable_bindings = let parse str = try @@ -810,6 +822,13 @@ let atom_or_local_list = description, with explicit directory (e.g. `./foo.opam' or `.')" atom_or_local +let atom_or_dir_list = + arg_list "PACKAGES" + "List of package names, with an optional version or constraint, e.g `pkg', \ + `pkg.1.0' or `pkg>=0.5' ; or directory names containing package \ + description, with explicit directory (e.g. `./srcdir' or `.')" + atom_or_dir + let nonempty_atom_list = nonempty_arg_list "PACKAGES" "List of package names, with an optional version or constraint, \ diff --git a/src/client/opamArg.mli b/src/client/opamArg.mli index 67a911dc3d6..ff8b8ae6f82 100644 --- a/src/client/opamArg.mli +++ b/src/client/opamArg.mli @@ -63,6 +63,9 @@ val atom_or_local_list: [ `Atom of atom | `Filename of filename | `Dirname of dirname ] list Term.t +val atom_or_dir_list: + [ `Atom of atom | `Dirname of dirname ] list Term.t + (** Generic argument list builder *) val arg_list: string -> string -> 'a Arg.converter -> 'a list Term.t @@ -169,6 +172,9 @@ val atom: atom Arg.converter val atom_or_local: [ `Atom of atom | `Filename of filename | `Dirname of dirname ] Arg.converter +val atom_or_dir: + [ `Atom of atom | `Dirname of dirname ] Arg.converter + (** [var=value,...] argument *) val variable_bindings: (OpamVariable.t * string) list Arg.converter diff --git a/src/client/opamAuxCommands.mli b/src/client/opamAuxCommands.mli index 6c5f13442a1..88eb1de2079 100644 --- a/src/client/opamAuxCommands.mli +++ b/src/client/opamAuxCommands.mli @@ -46,12 +46,10 @@ val resolve_locals: location, according to what is currently pinned, and returns the corresponding list of atoms. Prints warnings for directories where nothing is pinned, or opam files corresponding to no pinned package. - - NOTE: opam files are currently not supported and a fatal error. *) val resolve_locals_pinned: 'a switch_state -> - [ `Atom of atom | `Filename of filename | `Dirname of dirname ] list -> + [ `Atom of atom | `Dirname of dirname ] list -> atom list (** Resolves the opam files in the list to package name and location, pins the diff --git a/src/client/opamCommands.ml b/src/client/opamCommands.ml index 134b030ebff..fff254500ed 100644 --- a/src/client/opamCommands.ml +++ b/src/client/opamCommands.ml @@ -1221,7 +1221,7 @@ let remove = ignore @@ OpamClient.remove st ~autoremove ~force atoms in Term.(const remove $global_options $build_options $autoremove $force $destdir - $atom_or_local_list), + $atom_or_dir_list), term_info "remove" ~doc ~man (* REINSTALL *) @@ -1305,7 +1305,7 @@ let reinstall = | _, _::_ -> `Error (true, "Package arguments not allowed with this option") in - Term.(ret (const reinstall $global_options $build_options $atom_or_local_list + Term.(ret (const reinstall $global_options $build_options $atom_or_dir_list $cmd)), term_info "reinstall" ~doc ~man @@ -1425,7 +1425,7 @@ let upgrade = `Ok () in Term.(ret (const upgrade $global_options $build_options $fixup $check $all - $atom_or_local_list)), + $atom_or_dir_list)), term_info "upgrade" ~doc ~man (* REPOSITORY *) From 7ab3f28ef94dc792cbd11344c2d6feea1c232b83 Mon Sep 17 00:00:00 2001 From: Louis Gesbert Date: Wed, 22 Nov 2017 12:35:58 +0100 Subject: [PATCH 3/7] On 'opam switch create DIR', select the unambiguous compiler if there is one this will help with locked opam files, when the compiler is outside of the default selection --- src/client/opamAuxCommands.ml | 100 ++++++++++++++++++++------------- src/client/opamAuxCommands.mli | 3 +- 2 files changed, 64 insertions(+), 39 deletions(-) diff --git a/src/client/opamAuxCommands.ml b/src/client/opamAuxCommands.ml index e294adf27e9..a7f7d5eac51 100644 --- a/src/client/opamAuxCommands.ml +++ b/src/client/opamAuxCommands.ml @@ -392,7 +392,7 @@ let get_compatible_compiler ?repos rt dir = match OpamFile.OPAM.version_opt opam with | Some v -> OpamPackage.create name v, opam | None -> - let v = OpamPackage.Version.of_string "dev" in + let v = OpamPackage.Version.of_string "~dev" in OpamPackage.create name v, OpamFile.OPAM.with_version v opam in @@ -404,47 +404,71 @@ let get_compatible_compiler ?repos rt dir = let local_atoms = OpamSolution.eq_atoms_of_packages local_packages in - try - let univ = - let virt_st = - OpamSwitchState.load_virtual ?repos_list:repos gt rt - in - let opams = - OpamPackage.Map.union (fun _ x -> x) virt_st.opams local_opams - in - let virt_st = - { virt_st with - opams; - packages = - OpamPackage.Set.union virt_st.packages local_packages; - available_packages = lazy ( - OpamPackage.Map.filter (fun package opam -> - OpamFilter.eval_to_bool ~default:false - (OpamPackageVar.resolve_switch_raw ~package gt - (OpamSwitch.of_dirname dir) - OpamFile.Switch_config.empty) - (OpamFile.OPAM.available opam)) - opams - |> OpamPackage.keys); - } - in - OpamSwitchState.universe virt_st - ~requested:(OpamPackage.names_of_packages local_packages) - Query + let virt_st = + let virt_st = + OpamSwitchState.load_virtual ?repos_list:repos gt rt + in + let opams = + OpamPackage.Map.union (fun _ x -> x) virt_st.opams local_opams in + { virt_st with + opams; + packages = + OpamPackage.Set.union virt_st.packages local_packages; + available_packages = lazy ( + OpamPackage.Map.filter (fun package opam -> + OpamFilter.eval_to_bool ~default:false + (OpamPackageVar.resolve_switch_raw ~package gt + (OpamSwitch.of_dirname dir) + OpamFile.Switch_config.empty) + (OpamFile.OPAM.available opam)) + opams + |> OpamPackage.keys); + } + in + let univ = + OpamSwitchState.universe virt_st + ~requested:(OpamPackage.names_of_packages local_packages) + Query + in + try + (* Find a matching compiler from the default selection *) List.find (fun atoms -> OpamSolver.atom_coinstallability_check univ (local_atoms @ atoms)) candidates with Not_found -> - OpamConsole.warning - "The default compiler selection: %s\n\ - is not compatible with the local packages found at %s.\n\ - You can use `--compiler` to select a different compiler." - (OpamFormula.to_string default_compiler) - (OpamFilename.Dir.to_string dir); - if OpamConsole.confirm - "Continue anyway, with no compiler selected ?" - then [] - else OpamStd.Sys.exit_because `Aborted + (* Find if there is a single possible dependency having Pkgflag_Compiler *) + let alldeps = + OpamSolver.dependencies + ~depopts:false ~build:true ~post:false ~installed:false + univ local_packages + in + let compilers = + OpamPackage.Set.filter (fun nv -> + OpamFile.OPAM.has_flag Pkgflag_Compiler + (OpamSwitchState.opam virt_st nv)) + (OpamPackage.Set.of_list alldeps) + in + let compilers = + OpamPackage.Set.filter (fun c -> + OpamSolver.atom_coinstallability_check univ + (OpamSolution.eq_atom_of_package c :: local_atoms)) + compilers + in + try + [OpamSolution.eq_atom_of_package + (OpamPackage.Set.choose_one compilers)] + with Not_found | Failure _ -> + OpamConsole.warning + "The default compiler selection: %s\n\ + is not compatible with the local packages found at %s, and the \ + packages don't specify an unambiguous compiler.\n\ + You can use `--compiler` to manually select a specific compiler." + (OpamFormula.to_string default_compiler) + (OpamFilename.Dir.to_string dir); + if OpamConsole.confirm + "Continue anyway, with no specific compiler selected ?" + then [] + else OpamStd.Sys.exit_because `Aborted diff --git a/src/client/opamAuxCommands.mli b/src/client/opamAuxCommands.mli index 88eb1de2079..b2cff9aee6c 100644 --- a/src/client/opamAuxCommands.mli +++ b/src/client/opamAuxCommands.mli @@ -75,7 +75,8 @@ val simulate_autopin: 'a switch_state * atom list (** Scans for package definition files in a directory, and selects a compiler - that is compatible with them from the configured default compiler list. + that is compatible with them from the configured default compiler list, or + that is unambiguously selected by the package definitions. Returns the corresponding atoms. If no compiler matches, prints a warning, and returns the empty list after user confirmation. *) val get_compatible_compiler: From b9e1b069a887a0302fb67e349e50ceda925807e3 Mon Sep 17 00:00:00 2001 From: Louis Gesbert Date: Wed, 22 Nov 2017 12:43:25 +0100 Subject: [PATCH 4/7] Add 'opam --locked' To automatically make use of .opam.locked files --- src/client/opamAuxCommands.ml | 36 ++++++++++++++++++++++------------ src/client/opamAuxCommands.mli | 16 +++++++++++---- src/client/opamCommands.ml | 31 ++++++++++++++++++++++------- 3 files changed, 60 insertions(+), 23 deletions(-) diff --git a/src/client/opamAuxCommands.ml b/src/client/opamAuxCommands.ml index a7f7d5eac51..c5accacbbc5 100644 --- a/src/client/opamAuxCommands.ml +++ b/src/client/opamAuxCommands.ml @@ -88,9 +88,16 @@ let url_with_local_branch = function | None -> url) | url -> url -let opams_of_dir d = +let opams_of_dir ?(locked=false) d = let files = OpamPinned.files_in_source d in List.fold_left (fun acc (n, f) -> + let f = + let locked_f = + OpamFilename.add_extension (OpamFile.filename f) "locked" + in + if locked && OpamFilename.exists locked_f then OpamFile.make locked_f + else f + in let name = let open OpamStd.Option.Op in n >>+ fun () -> @@ -152,7 +159,7 @@ let resolve_locals_pinned st atom_or_local_list = in List.rev atoms -let resolve_locals ?(quiet=false) atom_or_local_list = +let resolve_locals ?(quiet=false) ?locked atom_or_local_list = let target_dir dir = let d = OpamFilename.Dir.to_string dir in let backend = OpamUrl.guess_version_control d in @@ -163,7 +170,7 @@ let resolve_locals ?(quiet=false) atom_or_local_list = List.fold_left (fun (to_pin, atoms) -> function | `Atom a -> to_pin, a :: atoms | `Dirname d -> - let names_files = opams_of_dir d in + let names_files = opams_of_dir ?locked d in if names_files = [] && not quiet then OpamConsole.warning "No package definitions found at %s" (OpamFilename.Dir.to_string d); @@ -205,8 +212,8 @@ let resolve_locals ?(quiet=false) atom_or_local_list = (OpamUrl.to_string t)) duplicates) -let autopin_aux st ?quiet atom_or_local_list = - let to_pin, atoms = resolve_locals ?quiet atom_or_local_list in +let autopin_aux st ?quiet ?locked atom_or_local_list = + let to_pin, atoms = resolve_locals ?quiet ?locked atom_or_local_list in if to_pin = [] then atoms, to_pin, OpamPackage.Set.empty, OpamPackage.Set.empty else @@ -241,6 +248,11 @@ let autopin_aux st ?quiet atom_or_local_list = with Not_found -> false) to_pin in + log "to pin: %a" + (slog @@ OpamStd.List.concat_map " " @@ + fun (name, _, opam_f) -> OpamPackage.Name.to_string name ^"->"^ + OpamFile.to_string opam_f) + to_pin; let already_pinned_set = List.fold_left (fun acc (name, _, _) -> OpamPackage.Set.add (OpamPinned.package st name) acc) @@ -304,9 +316,9 @@ let fix_atom_versions_in_set set atoms = (OpamPackage.package_of_name_opt set name)) atoms -let simulate_autopin st ?quiet atom_or_local_list = +let simulate_autopin st ?quiet ?locked atom_or_local_list = let atoms, to_pin, obsolete_pins, already_pinned_set = - autopin_aux st ?quiet atom_or_local_list + autopin_aux st ?quiet ?locked atom_or_local_list in if to_pin = [] then st, atoms else let st = @@ -318,12 +330,12 @@ let simulate_autopin st ?quiet atom_or_local_list = let atoms = fix_atom_versions_in_set pins atoms in st, atoms -let autopin st ?(simulate=false) ?quiet atom_or_local_list = +let autopin st ?(simulate=false) ?quiet ?locked atom_or_local_list = if OpamStateConfig.(!r.dryrun) || OpamClientConfig.(!r.show) then - simulate_autopin st atom_or_local_list + simulate_autopin st ?quiet ?locked atom_or_local_list else let atoms, to_pin, obsolete_pins, already_pinned_set = - autopin_aux st ?quiet atom_or_local_list + autopin_aux st ?quiet ?locked atom_or_local_list in if to_pin = [] && OpamPackage.Set.is_empty obsolete_pins && OpamPackage.Set.is_empty already_pinned_set @@ -374,7 +386,7 @@ let autopin st ?(simulate=false) ?quiet atom_or_local_list = let atoms = fix_atom_versions_in_set pins atoms in st, atoms -let get_compatible_compiler ?repos rt dir = +let get_compatible_compiler ?repos ?locked rt dir = let gt = rt.repos_global in let default_compiler = OpamFile.Config.default_compiler gt.config @@ -383,7 +395,7 @@ let get_compatible_compiler ?repos rt dir = (OpamConsole.warning "No compiler selected"; []) else let candidates = OpamFormula.to_dnf default_compiler in - let local_files = opams_of_dir dir in + let local_files = opams_of_dir ?locked dir in let local_opams = List.fold_left (fun acc (name, f) -> let opam = OpamFile.OPAM.safe_read f in diff --git a/src/client/opamAuxCommands.mli b/src/client/opamAuxCommands.mli index b2cff9aee6c..464e56e9355 100644 --- a/src/client/opamAuxCommands.mli +++ b/src/client/opamAuxCommands.mli @@ -36,9 +36,11 @@ val name_and_dir_of_opam_file: filename -> name option * dirname (** Resolves the opam files and directories in the list to package name and location, and returns the corresponding pinnings and atoms. May fail and exit if package names for provided [`Filename] could not be inferred, or if - the same package name appears multiple times *) + the same package name appears multiple times. + If [locked], the [*.locked] counterparts of opam files are used if present. +*) val resolve_locals: - ?quiet:bool -> + ?quiet:bool -> ?locked:bool -> [ `Atom of atom | `Filename of filename | `Dirname of dirname ] list -> (name * OpamUrl.t * OpamFile.OPAM.t OpamFile.t) list * atom list @@ -58,11 +60,14 @@ val resolve_locals_pinned: return the switch state with the package definitions that would have been obtained if pinning. Also synchronises the specified directories, that is, unpins any package pinned there but not current (no more corresponding opam - file). *) + file). + If [locked], the [*.locked] counterparts of opam files are used if present. + *) val autopin: rw switch_state -> ?simulate:bool -> ?quiet:bool -> + ?locked:bool -> [ `Atom of atom | `Filename of filename | `Dirname of dirname ] list -> rw switch_state * atom list @@ -71,6 +76,7 @@ val autopin: val simulate_autopin: 'a switch_state -> ?quiet:bool -> + ?locked:bool -> [ `Atom of atom | `Filename of filename | `Dirname of dirname ] list -> 'a switch_state * atom list @@ -80,4 +86,6 @@ val simulate_autopin: Returns the corresponding atoms. If no compiler matches, prints a warning, and returns the empty list after user confirmation. *) val get_compatible_compiler: - ?repos:repository_name list -> 'a repos_state -> dirname -> atom list + ?repos:repository_name list -> + ?locked:bool -> + 'a repos_state -> dirname -> atom list diff --git a/src/client/opamCommands.ml b/src/client/opamCommands.ml index fff254500ed..c32ff4793fd 100644 --- a/src/client/opamCommands.ml +++ b/src/client/opamCommands.ml @@ -1094,8 +1094,16 @@ let install = --destdir) to revert." Arg.(some dirname) None in + let locked = + mk_flag ["locked"] + "With a directory as argument, when a package definition file is found, \ + if a file by the same name with a $(i,.locked) extension is present \ + beside it, use the latter. This allows alternate local package \ + definitions, and is typically useful to provide more constrained \ + dependencies that describe a precise development environment." + in let install - global_options build_options add_to_roots deps_only restore destdir + global_options build_options add_to_roots deps_only restore destdir locked atoms_or_locals = apply_global_options global_options; apply_build_options build_options; @@ -1124,7 +1132,7 @@ let install = atoms_or_locals in let st, atoms = - OpamAuxCommands.autopin st ~simulate:deps_only atoms_or_locals + OpamAuxCommands.autopin st ~simulate:deps_only ~locked atoms_or_locals in if atoms = [] then (OpamConsole.msg "Nothing to do\n"; @@ -1142,7 +1150,7 @@ let install = in Term.ret Term.(const install $global_options $build_options - $add_to_roots $deps_only $restore $destdir + $add_to_roots $deps_only $restore $destdir $locked $atom_or_local_list), term_info "install" ~doc ~man @@ -1861,9 +1869,18 @@ let switch = containing opam package definitions), install the dependencies of the \ project but not the project itself." in + let locked = + mk_flag ["locked"] + "With a directory as argument, when a package definition file is found, \ + if a file by the same name with a $(i,.locked) extension is present \ + beside it, use the latter. This allows alternate local package \ + definitions, and is typically useful to provide more constrained \ + dependencies that describe a precise development environment." + in let switch global_options build_options command print_short - no_switch packages empty descr full no_install deps_only repos params = + no_switch packages empty descr full no_install deps_only locked repos + params = apply_global_options global_options; apply_build_options build_options; let packages = @@ -1880,7 +1897,7 @@ let switch = OpamSwitchCommand.guess_compiler_package ?repos rt (OpamSwitch.to_string switch) | None, None, true -> - OpamAuxCommands.get_compatible_compiler ?repos rt + OpamAuxCommands.get_compatible_compiler ?repos ~locked rt (OpamFilename.dirname_dir (OpamSwitch.get_root rt.repos_global.root switch)) | _ -> @@ -1960,7 +1977,7 @@ let switch = let st = if not no_install && not empty && OpamSwitch.is_external switch then let st, atoms = - OpamAuxCommands.autopin st ~simulate:deps_only ~quiet:true + OpamAuxCommands.autopin st ~simulate:deps_only ~locked ~quiet:true [`Dirname (OpamFilename.Dir.of_string switch_arg)] in OpamClient.install st atoms @@ -2066,7 +2083,7 @@ let switch = $global_options $build_options $command $print_short_flag $no_switch - $packages $empty $descr $full $no_install $deps_only + $packages $empty $descr $full $no_install $deps_only $locked $repos $params)), term_info "switch" ~doc ~man From 1b42cc2bf76e8c323e0e01630035073afd24db4f Mon Sep 17 00:00:00 2001 From: Louis Gesbert Date: Wed, 22 Nov 2017 14:39:34 +0100 Subject: [PATCH 5/7] Avoid confirmation on pinning new package do dir --- src/client/opamPinCommand.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/client/opamPinCommand.ml b/src/client/opamPinCommand.ml index add9857f9bd..b137adb7b86 100644 --- a/src/client/opamPinCommand.ml +++ b/src/client/opamPinCommand.ml @@ -424,6 +424,7 @@ and source_pin in if not (OpamPackage.has_name st.packages name) && + opam_opt = None && not (OpamConsole.confirm "Package %s does not exist, create as a %s package ?" (OpamPackage.Name.to_string name) From b028eca4fb92798ba12a5cff18203c421cb619ce Mon Sep 17 00:00:00 2001 From: Louis Gesbert Date: Thu, 23 Nov 2017 14:36:34 +0100 Subject: [PATCH 6/7] Better local switch creation with --locked Better choice of compiler, without confirmation if unambiguous from the `opam[.locked]` file. This also polishes quite a few rough edges regarding local switch creation, in particular with combinations of `--show`, `pin-depends:`, `--deps-only`. --- src/client/opamAuxCommands.ml | 142 +++++++++++++++++++++------------ src/client/opamAuxCommands.mli | 6 +- src/client/opamPinCommand.ml | 5 +- 3 files changed, 96 insertions(+), 57 deletions(-) diff --git a/src/client/opamAuxCommands.ml b/src/client/opamAuxCommands.ml index c5accacbbc5..352c8990b33 100644 --- a/src/client/opamAuxCommands.ml +++ b/src/client/opamAuxCommands.ml @@ -248,11 +248,6 @@ let autopin_aux st ?quiet ?locked atom_or_local_list = with Not_found -> false) to_pin in - log "to pin: %a" - (slog @@ OpamStd.List.concat_map " " @@ - fun (name, _, opam_f) -> OpamPackage.Name.to_string name ^"->"^ - OpamFile.to_string opam_f) - to_pin; let already_pinned_set = List.fold_left (fun acc (name, _, _) -> OpamPackage.Set.add (OpamPinned.package st name) acc) @@ -327,6 +322,24 @@ let simulate_autopin st ?quiet ?locked atom_or_local_list = in let st, pins = simulate_local_pinnings st to_pin in let pins = OpamPackage.Set.union pins already_pinned_set in + let pin_depends = + OpamPackage.Set.fold (fun nv acc -> + List.fold_left (fun acc (nv,target) -> + OpamPackage.Map.add nv target acc) + acc + (OpamFile.OPAM.pin_depends (OpamSwitchState.opam st nv))) + pins OpamPackage.Map.empty + in + if not (OpamPackage.Map.is_empty pin_depends) then + (OpamConsole.msg "Would pin the following:\n%s" + (OpamStd.Format.itemize (fun (nv, url) -> + Printf.sprintf "%s to %s" + (OpamConsole.colorise `bold (OpamPackage.to_string nv)) + (OpamConsole.colorise `underline (OpamUrl.to_string url))) + (OpamPackage.Map.bindings pin_depends)); + OpamConsole.note "The following may not reflect the above pinnings \ + (package definitions are not available yet)"; + OpamConsole.msg "\n"); let atoms = fix_atom_versions_in_set pins atoms in st, atoms @@ -380,7 +393,7 @@ let autopin st ?(simulate=false) ?quiet ?locked atom_or_local_list = let st = OpamPackage.Set.fold (fun nv st -> OpamPinCommand.handle_pin_depends st nv (OpamSwitchState.opam st nv)) - already_pinned_set st + (OpamPackage.Set.union pins already_pinned_set) st in let pins = OpamPackage.Set.union pins already_pinned_set in let atoms = fix_atom_versions_in_set pins atoms in @@ -388,13 +401,6 @@ let autopin st ?(simulate=false) ?quiet ?locked atom_or_local_list = let get_compatible_compiler ?repos ?locked rt dir = let gt = rt.repos_global in - let default_compiler = - OpamFile.Config.default_compiler gt.config - in - if default_compiler = Empty then - (OpamConsole.warning "No compiler selected"; []) - else - let candidates = OpamFormula.to_dnf default_compiler in let local_files = opams_of_dir ?locked dir in let local_opams = List.fold_left (fun acc (name, f) -> @@ -413,6 +419,12 @@ let get_compatible_compiler ?repos ?locked rt dir = local_files in let local_packages = OpamPackage.keys local_opams in + let pin_depends = + OpamPackage.Map.fold (fun _nv opam acc -> + List.fold_left (fun acc (nv,_) -> OpamPackage.Set.add nv acc) + acc (OpamFile.OPAM.pin_depends opam)) + local_opams OpamPackage.Set.empty + in let local_atoms = OpamSolution.eq_atoms_of_packages local_packages in @@ -423,19 +435,26 @@ let get_compatible_compiler ?repos ?locked rt dir = let opams = OpamPackage.Map.union (fun _ x -> x) virt_st.opams local_opams in + let available = lazy ( + OpamPackage.Map.filter (fun package opam -> + OpamFilter.eval_to_bool ~default:false + (OpamPackageVar.resolve_switch_raw ~package gt + (OpamSwitch.of_dirname dir) + OpamFile.Switch_config.empty) + (OpamFile.OPAM.available opam)) + opams + |> OpamPackage.keys + ) in + let open OpamPackage.Set.Op in { virt_st with - opams; + opams = + OpamPackage.Set.fold (fun nv acc -> + OpamPackage.Map.add nv (OpamFile.OPAM.create nv) acc) + pin_depends opams; packages = - OpamPackage.Set.union virt_st.packages local_packages; - available_packages = lazy ( - OpamPackage.Map.filter (fun package opam -> - OpamFilter.eval_to_bool ~default:false - (OpamPackageVar.resolve_switch_raw ~package gt - (OpamSwitch.of_dirname dir) - OpamFile.Switch_config.empty) - (OpamFile.OPAM.available opam)) - opams - |> OpamPackage.keys); + virt_st.packages ++ local_packages ++ pin_depends; + available_packages = + lazy (Lazy.force available ++ pin_depends); } in let univ = @@ -443,41 +462,58 @@ let get_compatible_compiler ?repos ?locked rt dir = ~requested:(OpamPackage.names_of_packages local_packages) Query in + (* Find if there is a single possible dependency having Pkgflag_Compiler *) + let alldeps = + OpamSolver.dependencies + ~depopts:false ~build:true ~post:true ~installed:false + univ local_packages + in + let compilers = + OpamPackage.Set.filter (fun nv -> + OpamFile.OPAM.has_flag Pkgflag_Compiler + (OpamSwitchState.opam virt_st nv)) + (OpamPackage.Set.of_list alldeps) + in + let compilers = + OpamSolver.installable_subset + {univ with u_base = local_packages; u_installed = local_packages} + compilers + in try - (* Find a matching compiler from the default selection *) - List.find - (fun atoms -> - OpamSolver.atom_coinstallability_check univ - (local_atoms @ atoms)) - candidates - with Not_found -> - (* Find if there is a single possible dependency having Pkgflag_Compiler *) - let alldeps = - OpamSolver.dependencies - ~depopts:false ~build:true ~post:false ~installed:false - univ local_packages - in - let compilers = - OpamPackage.Set.filter (fun nv -> - OpamFile.OPAM.has_flag Pkgflag_Compiler - (OpamSwitchState.opam virt_st nv)) - (OpamPackage.Set.of_list alldeps) - in - let compilers = - OpamPackage.Set.filter (fun c -> + [OpamSolution.eq_atom_of_package + (OpamPackage.Set.choose_one compilers)] + with + | Not_found -> + OpamConsole.warning + "No possible installation was found including a compiler and the \ + selected packages."; + if OpamClientConfig.(!r.show) || + OpamConsole.confirm + "Create the switch with no specific compiler selected, and attempt to \ + continue anyway ?" + then [] + else OpamStd.Sys.exit_because `Aborted + | Failure _ -> + (* Find a matching compiler from the default selection *) + let default_compiler = + OpamFile.Config.default_compiler gt.config + in + if default_compiler = Empty then + (OpamConsole.warning "No compiler selected"; []) + else + let candidates = OpamFormula.to_dnf default_compiler in + try + List.find + (fun atoms -> OpamSolver.atom_coinstallability_check univ - (OpamSolution.eq_atom_of_package c :: local_atoms)) - compilers - in - try - [OpamSolution.eq_atom_of_package - (OpamPackage.Set.choose_one compilers)] - with Not_found | Failure _ -> + (local_atoms @ atoms)) + candidates + with Not_found -> OpamConsole.warning "The default compiler selection: %s\n\ is not compatible with the local packages found at %s, and the \ packages don't specify an unambiguous compiler.\n\ - You can use `--compiler` to manually select a specific compiler." + You can use `--compiler` to manually select one." (OpamFormula.to_string default_compiler) (OpamFilename.Dir.to_string dir); if OpamConsole.confirm diff --git a/src/client/opamAuxCommands.mli b/src/client/opamAuxCommands.mli index 464e56e9355..f6504fb9665 100644 --- a/src/client/opamAuxCommands.mli +++ b/src/client/opamAuxCommands.mli @@ -61,8 +61,12 @@ val resolve_locals_pinned: obtained if pinning. Also synchronises the specified directories, that is, unpins any package pinned there but not current (no more corresponding opam file). + + This also handles [pin-depends:] of the local packages. That part is done + even if [simulate] is [true]. + If [locked], the [*.locked] counterparts of opam files are used if present. - *) +*) val autopin: rw switch_state -> ?simulate:bool -> diff --git a/src/client/opamPinCommand.ml b/src/client/opamPinCommand.ml index b137adb7b86..6782c6c2701 100644 --- a/src/client/opamPinCommand.ml +++ b/src/client/opamPinCommand.ml @@ -38,8 +38,7 @@ let read_opam_file_for_pinning name f url = let warns = if opam <> opam0 then OpamFileTools.lint opam else warns in if warns <> [] then (OpamConsole.warning - "Failed checks on %s package definition from source at %s \ - (fix with 'opam pin edit'):" + "Failed checks on %s package definition from source at %s:" (OpamPackage.Name.to_string name) (OpamUrl.to_string url); OpamConsole.errmsg "%s\n" (OpamFileTools.warns_to_string warns)); @@ -357,7 +356,7 @@ let rec handle_pin_depends st nv opam = (OpamConsole.colorise `underline (OpamUrl.to_string url))) extra_pins); if not (OpamConsole.confirm "Continue ?") then - (OpamConsole.msg "You can specify --ignore-pin-depends to bypass\n"; (* TODO *) + (OpamConsole.msg "You can specify --ignore-pin-depends to bypass\n"; OpamStd.Sys.exit_because `Aborted); List.fold_left (fun st (nv, url) -> source_pin st nv.name ~version:nv.version (Some url) From 2d8dd874aae52149c1d32f233f6ff55140d3348a Mon Sep 17 00:00:00 2001 From: Louis Gesbert Date: Thu, 23 Nov 2017 15:19:44 +0100 Subject: [PATCH 7/7] Update CHANGES --- CHANGES | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/CHANGES b/CHANGES index e7d35fd9caa..3e081e6cc24 100644 --- a/CHANGES +++ b/CHANGES @@ -16,13 +16,16 @@ are not marked). * Shorten conflict messages even more * Added `opam admin add-constraint` to amend a set of reverse dependencies in a repository -* New format for `depexts:`, easier to understand and more flexible +* New format for `depexts:`, easier to understand and more flexible. Depexts for + the host can now be inferred by opam * Optimised search criteria for the built-in solver * Added a `build-id` variable to identify package builds * Extend hooks (new variable `installed-files`, new session hooks) * `opam switch create DIR` now installs packages defined in `DIR` * Added system-related variables `arch`, `os`, `os-distribution`, `os-family`, `os-version` +* Added support for using `opam.locked` files instead of `opam` ones (`--locked`) +* Opam plugins are now made available across switches 2.0.0~beta4 * Building with OCaml < 4.02.3 is no longer supported