[SCM] Debian package checker branch, master, updated. 2.5.10-178-g33ece45
The following commit has been merged in the master branch:
commit 15855b0d56018ee89418a28378975a8f3c715d00
Author: Niels Thykier <niels@thykier.net>
Date: Wed Sep 26 15:16:25 2012 +0200
L::CollScript: Parse "<coll> [<type>]" dependencies
Signed-off-by: Niels Thykier <niels@thykier.net>
diff --git a/collection/index.desc b/collection/index.desc
index 1f16abb..8b02536 100644
--- a/collection/index.desc
+++ b/collection/index.desc
@@ -1,6 +1,6 @@
Collector-Script: index
Info: This script create an index file of the contents of a package.
Type: source, binary, udeb
-Needs-Info: unpacked
+Needs-Info: unpacked [source]
Version: 3
diff --git a/lib/Lintian/CollScript.pm b/lib/Lintian/CollScript.pm
index 7521abc..fb77e74 100644
--- a/lib/Lintian/CollScript.pm
+++ b/lib/Lintian/CollScript.pm
@@ -76,7 +76,6 @@ sub new {
'type' => $header->{'type'},
'version' => $header->{'version'},
'type-table' => {},
- 'needs_info' => [split /\s*,\s*/, $header->{'needs-info'}//''],
'auto_remove' => 0,
};
$self->{'script_path'} = dirname ($file) . '/' . $self->{'name'};
@@ -88,9 +87,40 @@ sub new {
bless $self, $class;
+ $self->_parse_needs ($header->{'needs-info'});
+
return $self;
}
+sub _parse_needs {
+ my ($self, $needs) = @_;
+ my @min = ();
+ my %typespec = ();
+ my %seen = ();
+ my @max = ();
+
+ foreach my $part (split /\s*,\s*/, $needs//'') {
+ if ($part =~ m/^ \s* (\S+) \s* \[ \s* ( [^]]+ ) \s* \] \s*$/x) {
+ my ($dep, $typelist) = ($1, $2);
+ my @types = split m/\s++/, $typelist;
+ if (@types) {
+ push @max, $dep unless exists $seen{$dep};
+ foreach my $type (@types) {
+ push @{ $typespec{$type} }, $dep;
+ }
+ } else {
+ croak "Unknown conditional dependency in coll $self->{'name'}: $part\n";
+ }
+ } else {
+ push @min, $part;
+ push @max, $part unless exists $seen{$part};
+ }
+ }
+ $self->{'needs_info'}->{'min'} = \@min;
+ $self->{'needs_info'}->{'type'} = \%typespec;
+ $self->{'needs_info'}->{'max'} = \@max;
+}
+
=back
=head1 INSTANCE METHODS
@@ -128,7 +158,7 @@ Lintian::CollScript->mk_ro_accessors (qw(name type version auto_remove
script_path
));
-=item needs_info
+=item needs_info ([COND])
Returns a list of all items listed in the Needs-Info field. Neither
the list nor its contents should be modified.
@@ -136,8 +166,8 @@ the list nor its contents should be modified.
=cut
sub needs_info {
- my ($self) = @_;
- return @{ $self->{'needs_info'} };
+ my ($self, $cond) = @_;
+ return @{ $self->{'needs_info'}->{'max'} };
}
=item is_type (TYPE)
diff --git a/t/scripts/needs-info-exists.t b/t/scripts/needs-info-exists.t
index b382d73..c6d8db2 100755
--- a/t/scripts/needs-info-exists.t
+++ b/t/scripts/needs-info-exists.t
@@ -19,6 +19,7 @@
use strict;
use Test::More;
+use Lintian::CollScript;
use Lintian::Util qw(read_dpkg_control);
# Find all of the desc files in either collection or checks. We'll do one
@@ -31,8 +32,15 @@ plan tests => scalar(@DESCS);
# its Needs-Info script references exist.
for my $desc (@DESCS) {
my ($header) = read_dpkg_control($desc);
- my @needs = split(/\s*,\s*/, $header->{'needs-info'} || '');
+ my @needs;
my @missing;
+
+ if ($header->{'collector-script'}) {
+ my $coll = Lintian::CollScript->new ($desc);
+ @needs = $coll->needs_info;
+ } else {
+ @needs = split(/\s*,\s*/, $header->{'needs-info'} || '');
+ }
for my $coll (@needs) {
unless (-f "$ENV{LINTIAN_ROOT}/collection/$coll") {
push(@missing, $coll);
diff --git a/t/scripts/unpack-level.t b/t/scripts/unpack-level.t
index 7660c65..63e47fa 100755
--- a/t/scripts/unpack-level.t
+++ b/t/scripts/unpack-level.t
@@ -19,13 +19,14 @@
use strict;
use Test::More;
+use Lintian::CollScript;
use Lintian::Util qw(read_dpkg_control slurp_entire_file);
# Find all of the desc files in either collection or checks. We'll do one
# check per description.
our @DESCS = (<$ENV{LINTIAN_ROOT}/collection/*.desc>,
<$ENV{LINTIAN_ROOT}/checks/*.desc>);
-plan tests => scalar(@DESCS) * 2;
+plan tests => scalar(@DESCS);
my @l2refs = (
qr|->unpacked|,
@@ -39,17 +40,20 @@ my @l2refs = (
# it is level two then there should be a reference
for my $desc (@DESCS) {
my ($header) = read_dpkg_control($desc);
- my $level = $header->{'unpack-level'};
+ my @needs;
+ if ($header->{'collector-script'}) {
+ my $coll = Lintian::CollScript->new ($desc);
+ @needs = $coll->needs_info;
+ } else {
+ @needs = split(/\s*,\s*/, $header->{'needs-info'} || '');
+ }
if ($desc =~ m/lintian\.desc$/) {
- ok(!defined($level), "lintian.desc doesn't define unpack-level");
ok(1, "lintian.desc has valid needs-info for unpack level");
next;
}
- my $info = $header->{'needs-info'} || '';
- chomp $info;
- my %ninfo = map {$_ => 1} split(/\s*,\s*/, $info);
+ my %ninfo = map {$_ => 1} @needs;
my ($file) = split(/\.desc$/, $desc);
my $code = slurp_entire_file($file);
my $requires_unpacked = 0;
@@ -66,9 +70,6 @@ for my $desc (@DESCS) {
# it is ok that collection/unpacked doesn't depend on itself :)
$requires_unpacked = 0 if ($short eq 'collection/unpacked.desc');
- # no script should be using unpack-level: n anymore
- ok(!defined($level), "$short doesn't define unpack-level");
-
ok($requires_unpacked? defined($ninfo{'unpacked'}) : !defined($ninfo{'unpacked'}),
"$short has valid needs-info for unpack level");
}
--
Debian package checker
Reply to: