[SCM] Debian package checker branch, master, updated. 2.5.10-85-g79c161b
The following commit has been merged in the master branch:
commit 79c161b3f6b15651e8f808af94d90ab697c99d97
Author: Niels Thykier <niels@thykier.net>
Date: Mon Jul 23 16:28:41 2012 +0200
L::Collect: Allow indirect "Needs-Info" dependencies
Instead of manually keeping track of transitive dependencies, allow
methods in L::Collect to declare a "symbolic" dependency on another
method by prefixing the dependency with a colon.
As an example, is_conffile (which relies entirely on the control
method) now declares a dependency on ":control" rather than
"bin-pkg-control".
The indirect dependencies are only allowed in L::Collect (and not in
the Needs-Info of collections or checks).
needs-info-missing.t has been updated to cope with these symbolic
dependencies and even "or'ed" dependencies, which were previous
silently ignored. "or'ed" dependencies currently only happens when
the Source and the Binary variant of a method has different
dependencies (e.g. changelog).
Signed-off-by: Niels Thykier <niels@thykier.net>
diff --git a/lib/Lintian/Collect/Binary.pm b/lib/Lintian/Collect/Binary.pm
index 8a8ab92..3beae81 100644
--- a/lib/Lintian/Collect/Binary.pm
+++ b/lib/Lintian/Collect/Binary.pm
@@ -41,7 +41,7 @@ sub new {
# Returns whether the package is a native package according to
# its version number
-# sub native Needs-Info <>
+# sub native Needs-Info :field
sub native {
my ($self) = @_;
return $self->{native} if exists $self->{native};
@@ -94,7 +94,7 @@ sub control_index {
# Like sorted_index except it returns the index for the control/metadata of
# binary package.
#
-# sub sorted_control_index Needs-Info bin-pkg-control
+# sub sorted_control_index Needs-Info :control_index
sub sorted_control_index {
my ($self) = @_;
# control_index does all our work for us, so call it if
@@ -324,7 +324,7 @@ sub java_info {
# field names are supported: all (pre-depends, depends, recommends, and
# suggests), strong (pre-depends and depends), and weak (recommends and
# suggests).
-# sub relation Needs-Info <>
+# sub relation Needs-Info :field
sub relation {
my ($self, $field) = @_;
$field = lc $field;
@@ -352,7 +352,7 @@ sub relation {
# Returns a truth value if the package appears to be transitional package.
# - this is based on the package description.
-# sub is_transitional Needs-Info <>
+# sub is_transitional Needs-Info :field
sub is_transitional {
my ($self) = @_;
my $desc = $self->field ('description')//'';
@@ -361,7 +361,7 @@ sub is_transitional {
# Returns a truth value if the file is listed in the conffiles file
# - Note files should be passed relative to the package root.
-# sub is_conffile Needs-Info bin-pkg-control
+# sub is_conffile Needs-Info :control
sub is_conffile {
my ($self, $file) = @_;
if (exists $self->{'conffiles'}) {
diff --git a/lib/Lintian/Collect/Package.pm b/lib/Lintian/Collect/Package.pm
index d79275b..d8cef08 100644
--- a/lib/Lintian/Collect/Package.pm
+++ b/lib/Lintian/Collect/Package.pm
@@ -77,7 +77,7 @@ sub index {
}
# Returns sorted file index (eqv to sort keys %{$info->index}), except it is cached.
-# sub sorted_index Needs-Info index
+# sub sorted_index Needs-Info :index
sub sorted_index {
my ($self) = @_;
# index does all our work for us, so call it if sorted_index has
diff --git a/lib/Lintian/Collect/Source.pm b/lib/Lintian/Collect/Source.pm
index 21b9d18..3249795 100644
--- a/lib/Lintian/Collect/Source.pm
+++ b/lib/Lintian/Collect/Source.pm
@@ -42,11 +42,11 @@ sub new {
# Get the changelog file of a source package as a Parse::DebianChangelog
# object. Returns undef if the changelog file couldn't be found.
-# sub changelog Needs-Info debfiles
+# sub changelog Needs-Info :debfiles
sub changelog {
my ($self) = @_;
return $self->{changelog} if exists $self->{changelog};
- my $dch = $self->lab_data_path ('debfiles/changelog');
+ my $dch = $self->debfiles ('changelog');
if (-l $dch || ! -f $dch) {
$self->{changelog} = undef;
} else {
@@ -72,7 +72,7 @@ sub diffstat {
# format 3.0 (quilt) packages, we base this on whether we have a Debian
# *.diff.gz file. 3.0 (quilt) packages are always non-native. Returns true
# if the package is native and false otherwise.
-# sub native Needs-Info <>
+# sub native Needs-Info :field
sub native {
my ($self) = @_;
return $self->{native} if exists $self->{native};
@@ -100,7 +100,7 @@ sub native {
# Returns a hash of binaries to the package type, assuming a type of deb
# unless the package type field is present.
-# sub binaries Needs-Info debfiles
+# sub binaries Needs-Info :binary_field
sub binaries {
my ($self) = @_;
return $self->{binaries} if exists $self->{binaries};
@@ -120,7 +120,7 @@ sub binaries {
# Returns the value of a source field in d/control or $def//undef
# if that field is not present.
-# sub source_field Needs-Info debfiles
+# sub source_field Needs-Info :_load_dctrl
sub source_field {
my ($self, $field, $def) = @_;
$self->_load_dctrl unless exists $self->{source_field};
@@ -131,7 +131,7 @@ sub source_field {
# Returns the value of a control field for a binary package or undef
# if that control field isn't present. This does not implement
# inheritance from the settings in the source stanza.
-# sub binary_field Needs-Info debfiles
+# sub binary_field Needs-Info :_load_dctrl
sub binary_field {
my ($self, $package, $field, $def) = @_;
$self->_load_dctrl unless exists $self->{binary_field};
@@ -205,7 +205,7 @@ sub _load_dctrl {
# following special field names are supported: all (pre-depends, depends,
# recommends, and suggests), strong (pre-depends and depends), and weak
# (recommends and suggests).
-# sub binary_relation Needs-Info debfiles
+# sub binary_relation Needs-Info :binary_field
sub binary_relation {
my ($self, $package, $field) = @_;
$field = lc $field;
@@ -238,7 +238,7 @@ sub binary_relation {
# following special field names are supported: build-depends-all
# (build-depends and build-depends-indep) and build-conflicts-all
# (build-conflicts and build-conflicts-indep).
-# sub relation Needs-Info <>
+# sub relation Needs-Info :field
sub relation {
my ($self, $field) = @_;
$field = lc $field;
@@ -267,7 +267,7 @@ sub relation {
# Similar to relation(), return a Lintian::Relation object for the given build
# relationship field, but ignore architecture restrictions. It supports the
# same special field names.
-# sub relation_noarch Needs-Info <>
+# sub relation_noarch Needs-Info :field
sub relation_noarch {
my ($self, $field) = @_;
$field = lc $field;
diff --git a/t/scripts/needs-info-missing.t b/t/scripts/needs-info-missing.t
index 2183618..90385ce 100755
--- a/t/scripts/needs-info-missing.t
+++ b/t/scripts/needs-info-missing.t
@@ -29,6 +29,14 @@ our @MODULES = (<$ENV{LINTIAN_ROOT}/lib/Lintian/Collect.pm>,
plan tests => scalar(@DESCS)+scalar(@MODULES);
+# Maps a sub to a Disjunctive Normal Form (DNF) of dependencies
+# e.g. "changelog-file,:field or debfiles,:field"
+# As it is a DNF, it is read as
+# "(changelog-file AND :field) OR (debfiles AND :field)".
+#
+# ":X" is a symbol dependency used in L::Collect{,::*}. It is useful
+# to declare an "indirect" dependency, so methods using (e.g.) the
+# "field" sub does not need to know what it depends on.
my %needs_info;
# Build the Needs-Info hash from the Collect modules
@@ -104,13 +112,12 @@ for my $desc (@DESCS) {
for my $sub (keys %subs) {
if (exists($needs_info{$sub})) {
- # TODO: try to satisfy either branch when an 'or' exists
- next if ($needs_info{$sub} =~ m/ or /);
- for my $needed (split(/,/, $needs_info{$sub})) {
- unless (exists($needs{$needed})) {
- $missing++;
- push @warnings, "$sub needs $needed\n";
- }
+ my @miss = find_missing (\%needs, $needs_info{$sub});
+ if (@miss) {
+ $missing++;
+ foreach my $needed (@miss) {
+ push @warnings, "$sub needs $needed\n";
+ }
}
} else {
push @warnings, "Unknown method \$info->$sub\n";
@@ -123,3 +130,42 @@ for my $desc (@DESCS) {
is($missing, 0, "$short has all required needs-info for Lintian::Collect") or
diag(@warnings);
}
+
+sub find_missing {
+ my ($declared, $depends) = @_;
+ my @missing = ();
+ my @unchecked = ($depends);
+ # Each $depline has the format "X,Y or Z", which is read as
+ # "(X and Y) or Z". This is also known as "Disjunctive Normal Form"
+ # (without negation).
+ while (my $depline = pop @unchecked) {
+ my @orlist = split m/\s+or\s+/o, $depline;
+ my $ok = 0;
+ ORDEP:
+ foreach my $ordep (@orlist) {
+ my @deps = split m/\s+,\s+/o, $ordep;
+ while (my $dep = pop @deps) {
+ # symbolic dependency ?
+ if ($dep =~ s/^://) {
+ # Handle with recursion
+ if (find_missing ($declared, $needs_info{$dep})) {
+ # cannot satisfy this part of the relation
+ next ORDEP;
+ }
+ next;
+ }
+ # ... "normal" dependency
+ unless (exists $declared->{$dep}) {
+ # cannot satisfy this part of the relation
+ next ORDEP;
+ }
+ }
+ $ok = 1;
+ last;
+ }
+ if (not $ok) {
+ push @missing, $depline;
+ }
+ }
+ return @missing;
+}
--
Debian package checker
Reply to: