From 4278a4863c96d9b3d5038e2eca297d2c33df1cae Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Thu, 18 Apr 2024 20:27:00 +0100 Subject: [PATCH 1/3] Some slightly obtuse instances of warning 41 The warnings emitted for guarded-dependency and no-dependency-guarded are not strictly necessary as they are protected by a filter which checks :installed (:installed at present never triggers warning 41). The warning for no-dependency-unguarded is unequivocally correct. --- master_changes.md | 1 + tests/reftests/lint.test | 27 +++++++++++++++++++++++++++ 2 files changed, 28 insertions(+) diff --git a/master_changes.md b/master_changes.md index 3132f8644b7..d2436c9238c 100644 --- a/master_changes.md +++ b/master_changes.md @@ -132,6 +132,7 @@ users) * env.win32: add regression test for reverting additions to PATH-like variables [#5935 @dra27] * env tests: add regression test for append/prepend operators to empty environment variables [#5925, #5935 @dra27] * env.win32: add regression test for handling the empty entry in PATH-like variables [#5926, #5935 @dra27] + * lint: add W41 examples [#5927 @dra27] ### Engine * Add `sort` command [#5935 @dra27] diff --git a/tests/reftests/lint.test b/tests/reftests/lint.test index 352b438d9f5..a7a1473f599 100644 --- a/tests/reftests/lint.test +++ b/tests/reftests/lint.test @@ -400,6 +400,33 @@ bug-reports: "https://nobug" messages: "foo" { bar:installed } ### opam lint ./lint.opam ${BASEDIR}/lint.opam: Passed. +### +opam-version: "2.0" +synopsis: "A word" +description: "Two words." +authors: "the testing team" +homepage: "egapemoh" +maintainer: "maint@tain.er" +license: "ISC" +dev-repo: "hg+https://to@li.nt" +bug-reports: "https://nobug" +depends: [ + "dependency" + "guarded-dependency" {os = ""} +] +build: [ + ["false"] {no-dependency-installed-only:installed} + ["true"] {dependency:installed} + ["%{guarded-dependency:share}%"] {guarded-dependency:installed} + ["%{guarded-dependency:share}%"] {guarded-dependency:installed & guarded-dependency:share != ""} + ["%{no-dependency-unguarded:share}%"] {no-dependency-unguarded:installed | no-dependency-unguarded:share != ""} + ["%{guarded-dependency:share}%" {guarded-dependency:installed}] + ["%{guarded-dependency:share}%%{no-dependency-guarded:share}%" {no-dependency-guarded:installed}] {guarded-dependency:installed} + ["%{guarded-dependency:share}%%{no-dependency-unguarded:share}%%{no-dependency-guarded:share}%" {no-dependency-guarded:installed}] {guarded-dependency:installed} +] +### opam lint ./lint.opam +${BASEDIR}/lint.opam: Warnings. + warning 41: Some packages are mentioned in package scripts or features, but there is no dependency or depopt toward them: "guarded-dependency", "no-dependency-guarded", "no-dependency-unguarded" ### : E42: The 'dev-repo:' field doesn't use version control. You should use URLs of the form "git://", "git+https://", "hg+https://"... ### opam-version: "2.0" From 2f165b44f6a8778948fe51279076f84339ab3085 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Thu, 18 Apr 2024 20:30:32 +0100 Subject: [PATCH 2/3] Relax warning 41 inside package:installed filters Warning 41 is never triggered for the use of package:installed. Extend this so that the warning is not triggered for any uses of package:foo _underneath_ package:installed, i.e. "%{package:foo}% {package:installed} can no longer cause warning 41 on package. --- master_changes.md | 1 + src/format/opamFilter.mli | 3 ++ src/state/opamFileTools.ml | 79 +++++++++++++++++++++++++++++++++++++- tests/reftests/lint.test | 2 +- 4 files changed, 83 insertions(+), 2 deletions(-) diff --git a/master_changes.md b/master_changes.md index d2436c9238c..aa8c761b295 100644 --- a/master_changes.md +++ b/master_changes.md @@ -58,6 +58,7 @@ users) * Fix extraction of tarballs on Windows which contain symlinks both when those symlinks can't be created or if they point to files which don't exist [#5953 @dra27] ## Lint + * W41: Relax warning 41 not to trigger on uses of package variables which are guarded by a package:installed filter [#5927 @dra27] ## Repository * Fix download URLs containing invalid characters on Windows (e.g. the ? character in `?full_index=1`) [#5921 @dra27] diff --git a/src/format/opamFilter.mli b/src/format/opamFilter.mli index b14c9928961..989a37c812e 100644 --- a/src/format/opamFilter.mli +++ b/src/format/opamFilter.mli @@ -155,6 +155,9 @@ val commands: env -> command list -> string list list (** Process a simpler command, without filters *) val single_command: env -> arg list -> string list +(** Extracts the list of variables from an argument *) +val simple_arg_variables: simple_arg -> full_variable list + (** Extracts variables appearing in a list of commands *) val commands_variables: command list -> full_variable list diff --git a/src/state/opamFileTools.ml b/src/state/opamFileTools.ml index c98b9b47792..dc3c6a3f33a 100644 --- a/src/state/opamFileTools.ml +++ b/src/state/opamFileTools.ml @@ -119,6 +119,75 @@ let map_all_filters f t = with_deprecated_build_test (map_commands t.deprecated_build_test) |> with_deprecated_build_doc (map_commands t.deprecated_build_doc) +(* unguarded_commands_variables is an alternative implementation of + OpamFilter.commands_variables which excludes package variables which are + guarded by an unambiguous {package:installed} filter. That is, at each level, + if assuming !package:installed reduces the filter to false, then the uses of + package:variable are not returned. This allows expressions like: + ["--with-foo=%{foo:share}%" {foo:installed}] or even + ["--with-foo"] {foo:installed & foo:bar != "baz"} not to trigger warning 41 + if the package is not explicitly depended on. *) + +let unguarded_commands_variables commands = + let is_installed_variable filter guarded_packages v = + match OpamVariable.Full.package v with + | None -> guarded_packages + | (Some name) as package -> + let is_installed var = + String.equal "installed" + (OpamVariable.to_string (OpamVariable.Full.variable var)) + in + let env var = + if Option.equal OpamPackage.Name.equal + (OpamVariable.Full.package var) package && + is_installed var then + Some (B false) + else + None + in + if is_installed v && + OpamFilter.partial_eval env filter = FBool false then + OpamPackage.Name.Set.add name guarded_packages + else + guarded_packages + in + let filter_guarded variables guarded_packages = + let is_unguarded v = + match OpamVariable.Full.package v with + | Some package -> + not (OpamPackage.Name.Set.mem package guarded_packages) + | None -> true + in + List.filter is_unguarded variables + in + let unguarded_packages_from_filter guarded_packages = function + | None -> guarded_packages, [] + | Some f -> + let filter_variables = OpamFilter.variables f in + let guarded_packages = + List.fold_left (is_installed_variable f) + guarded_packages filter_variables + in + guarded_packages, filter_guarded filter_variables guarded_packages + in + let unguarded_argument_variables guarded_packages (argument, filter) = + let guarded_packages, filter_variables = + unguarded_packages_from_filter guarded_packages filter + in + (filter_guarded (OpamFilter.simple_arg_variables argument) guarded_packages) + @ filter_variables + in + let unguarded_command_variables (command, filter) = + let guarded_packages, filter_variables = + unguarded_packages_from_filter OpamPackage.Name.Set.empty filter + in + let add_argument acc argument = + unguarded_argument_variables guarded_packages argument @ acc + in + List.fold_left add_argument filter_variables command + in + List.fold_left (fun acc c -> unguarded_command_variables c @ acc) [] commands + (* Returns all variables from all commands (or on given [command]) and all filters *) let all_variables ?exclude_post ?command t = let commands = @@ -130,6 +199,14 @@ let all_variables ?exclude_post ?command t = List.fold_left (fun acc f -> OpamFilter.variables f @ acc) [] (all_filters ?exclude_post t) +(* As all_variables, but any commands or arguments which are fully guarded by + package:installed are excluded; used for Warning 41 so that + ["%{foo:share}%" {foo:installed}] doesn't trigger a warning on foo *) +let all_unguarded_variables ?exclude_post t = + unguarded_commands_variables (all_commands t) @ + List.fold_left (fun acc f -> OpamFilter.variables f @ acc) + [] (all_filters ?exclude_post t) + let map_all_variables f t = let map_fld (x, flt) = x, OpamFilter.map_variables f flt in let map_optfld = function @@ -467,7 +544,7 @@ let t_lint ?check_extra_files ?(check_upstream=false) ?(all=false) t = -> OpamPackage.Name.Set.add n acc | _ -> acc) - OpamPackage.Name.Set.empty (all_variables ~exclude_post:true t) + OpamPackage.Name.Set.empty (all_unguarded_variables ~exclude_post:true t) in cond 41 `Warning "Some packages are mentioned in package scripts or features, but \ diff --git a/tests/reftests/lint.test b/tests/reftests/lint.test index a7a1473f599..d9123db8ff1 100644 --- a/tests/reftests/lint.test +++ b/tests/reftests/lint.test @@ -426,7 +426,7 @@ build: [ ] ### opam lint ./lint.opam ${BASEDIR}/lint.opam: Warnings. - warning 41: Some packages are mentioned in package scripts or features, but there is no dependency or depopt toward them: "guarded-dependency", "no-dependency-guarded", "no-dependency-unguarded" + warning 41: Some packages are mentioned in package scripts or features, but there is no dependency or depopt toward them: "no-dependency-unguarded" ### : E42: The 'dev-repo:' field doesn't use version control. You should use URLs of the form "git://", "git+https://", "hg+https://"... ### opam-version: "2.0" From 889a45b5d645aa51f713aa4d78686e4a8eaeda90 Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Mon, 20 May 2024 14:04:33 +0100 Subject: [PATCH 3/3] Tighten warning 41 w.r.t. depends/depopts The previous change means that a variable will definitely not be expanded unless the package has been installed. However, there is a timing issue which is not desirable - there is no guarantee that if either no-dependency-guarded or no-dependency-installed-only have been installed that they will be installed before or after the current package. This instability is not desirable, either. The check is therefore enhanced slightly so that foo:installed can only be used if depends or depopts in some way mentions the package (rather than doing a full tautology check on depends for whether foo is installed). --- master_changes.md | 1 + src/format/opamFormula.ml | 11 +++--- src/format/opamFormula.mli | 3 ++ src/state/opamFileTools.ml | 76 +++++++++++++++++++++++++++----------- tests/reftests/lint.test | 2 +- 5 files changed, 66 insertions(+), 27 deletions(-) diff --git a/master_changes.md b/master_changes.md index aa8c761b295..5485a4e3900 100644 --- a/master_changes.md +++ b/master_changes.md @@ -59,6 +59,7 @@ users) ## Lint * W41: Relax warning 41 not to trigger on uses of package variables which are guarded by a package:installed filter [#5927 @dra27] + * W41: Tighten w.r.t depends & depopts [#5927 @dra27] ## Repository * Fix download URLs containing invalid characters on Windows (e.g. the ? character in `?full_index=1`) [#5921 @dra27] diff --git a/src/format/opamFormula.ml b/src/format/opamFormula.ml index 6931055e492..9c48fdb19cd 100644 --- a/src/format/opamFormula.ml +++ b/src/format/opamFormula.ml @@ -379,12 +379,13 @@ let verifies f nv = check_version_formula cstr (OpamPackage.version nv)) name_formula +let all_names f = + fold_left (fun acc (name, _) -> + OpamPackage.Name.Set.add name acc) + OpamPackage.Name.Set.empty f + let packages pkgset f = - let names = - fold_left (fun acc (name, _) -> - OpamPackage.Name.Set.add name acc) - OpamPackage.Name.Set.empty f - in + let names = all_names f in (* dnf allows us to transform the formula into a union of intervals, where ignoring atoms for different package names works. *) let dnf = dnf_of_formula f in diff --git a/src/format/opamFormula.mli b/src/format/opamFormula.mli index 07bf7216b06..e3d6b08bd8e 100644 --- a/src/format/opamFormula.mli +++ b/src/format/opamFormula.mli @@ -161,6 +161,9 @@ val verifies: t -> OpamPackage.t -> bool (** Checks if a given set of (installed) packages satisfies a formula *) val satisfies_depends: OpamPackage.Set.t -> t -> bool +(** Returns the set of names referred to in a formula *) +val all_names: (OpamPackage.Name.t * 'a) formula -> OpamPackage.Name.Set.t + (** Returns the subset of packages possibly matching the formula (i.e. including all disjunction cases) *) val packages: OpamPackage.Set.t -> t -> OpamPackage.Set.t diff --git a/src/state/opamFileTools.ml b/src/state/opamFileTools.ml index dc3c6a3f33a..75f25bc6d4d 100644 --- a/src/state/opamFileTools.ml +++ b/src/state/opamFileTools.ml @@ -174,19 +174,35 @@ let unguarded_commands_variables commands = let guarded_packages, filter_variables = unguarded_packages_from_filter guarded_packages filter in - (filter_guarded (OpamFilter.simple_arg_variables argument) guarded_packages) - @ filter_variables + let variables_from_arguments = + filter_guarded (OpamFilter.simple_arg_variables argument) guarded_packages + in + guarded_packages, variables_from_arguments @ filter_variables in - let unguarded_command_variables (command, filter) = - let guarded_packages, filter_variables = + let unguarded_command_variables guarded_packages (command, filter) = + let filter_guarded_packages, filter_variables = unguarded_packages_from_filter OpamPackage.Name.Set.empty filter in - let add_argument acc argument = - unguarded_argument_variables guarded_packages argument @ acc + let add_argument (guarded_packages, acc) argument = + let guarded_packages, unguarded_variables = + unguarded_argument_variables guarded_packages argument + in + guarded_packages, unguarded_variables @ acc + in + let command_guarded_packages, unguarded_variables = + List.fold_left add_argument (filter_guarded_packages, filter_variables) + command + in + OpamPackage.Name.Set.union guarded_packages command_guarded_packages, + unguarded_variables + in + let f (guarded_packages, acc) c = + let guarded_packages, unguarded_variables = + unguarded_command_variables guarded_packages c in - List.fold_left add_argument filter_variables command + guarded_packages, (unguarded_variables @ acc) in - List.fold_left (fun acc c -> unguarded_command_variables c @ acc) [] commands + List.fold_left f (OpamPackage.Name.Set.empty, []) commands (* Returns all variables from all commands (or on given [command]) and all filters *) let all_variables ?exclude_post ?command t = @@ -203,7 +219,11 @@ let all_variables ?exclude_post ?command t = package:installed are excluded; used for Warning 41 so that ["%{foo:share}%" {foo:installed}] doesn't trigger a warning on foo *) let all_unguarded_variables ?exclude_post t = - unguarded_commands_variables (all_commands t) @ + let guarded_packages, unguarded_commands_variables = + unguarded_commands_variables (all_commands t) + in + guarded_packages, + unguarded_commands_variables @ List.fold_left (fun acc f -> OpamFilter.variables f @ acc) [] (all_filters ?exclude_post t) @@ -533,18 +553,32 @@ let t_lint ?check_extra_files ?(check_upstream=false) ?(all=false) t = ~detail:alpha_flags (alpha_flags <> [])); *) - (let undep_pkgs = - List.fold_left - (fun acc v -> - match OpamVariable.Full.package v with - | Some n when - t.OpamFile.OPAM.name <> Some n && - not (OpamPackage.Name.Set.mem n all_depends) && - OpamVariable.(Full.variable v <> of_string "installed") - -> - OpamPackage.Name.Set.add n acc - | _ -> acc) - OpamPackage.Name.Set.empty (all_unguarded_variables ~exclude_post:true t) + (let all_mentioned_packages = + OpamPackage.Name.Set.union + (OpamFormula.all_names t.depends) + (OpamFormula.all_names t.depopts) + in + let undep_pkgs = + let guarded_packages, all_unguarded_variables = + all_unguarded_variables ~exclude_post:true t + in + let first_lot = + List.fold_left + (fun acc v -> + match OpamVariable.Full.package v with + | Some n when + t.OpamFile.OPAM.name <> Some n && + not (OpamPackage.Name.Set.mem n all_depends) && + OpamVariable.(Full.variable v <> of_string "installed") + -> + OpamPackage.Name.Set.add n acc + | _ -> acc) + OpamPackage.Name.Set.empty all_unguarded_variables + in + let second_lot = + OpamPackage.Name.Set.diff guarded_packages all_mentioned_packages + in + OpamPackage.Name.Set.union first_lot second_lot in cond 41 `Warning "Some packages are mentioned in package scripts or features, but \ diff --git a/tests/reftests/lint.test b/tests/reftests/lint.test index d9123db8ff1..f9c47afbb2f 100644 --- a/tests/reftests/lint.test +++ b/tests/reftests/lint.test @@ -426,7 +426,7 @@ build: [ ] ### opam lint ./lint.opam ${BASEDIR}/lint.opam: Warnings. - warning 41: Some packages are mentioned in package scripts or features, but there is no dependency or depopt toward them: "no-dependency-unguarded" + warning 41: Some packages are mentioned in package scripts or features, but there is no dependency or depopt toward them: "no-dependency-guarded", "no-dependency-installed-only", "no-dependency-unguarded" ### : E42: The 'dev-repo:' field doesn't use version control. You should use URLs of the form "git://", "git+https://", "hg+https://"... ### opam-version: "2.0"