[SCM] Debian package checker branch, master, updated. 2.5.10-245-g5330ec7
The following commit has been merged in the master branch:
commit 5330ec719ca79a7d7610e64de0d0dedabfdf9996
Author: Niels Thykier <niels@thykier.net>
Date: Mon Nov 19 13:32:14 2012 +0100
L::CheckScript: Take an extra argument "basedir" in new
Signed-off-by: Niels Thykier <niels@thykier.net>
diff --git a/lib/Lintian/CheckScript.pm b/lib/Lintian/CheckScript.pm
index 0597b5e..409363a 100644
--- a/lib/Lintian/CheckScript.pm
+++ b/lib/Lintian/CheckScript.pm
@@ -38,7 +38,8 @@ Lintian::CheckScript - Check script meta data
use Lintian::CheckScript;
- my $cs = Lintian::CheckScript->new ("$ENV{'LINTIAN_ROOT'}/checks/files.desc");
+ my $cs = Lintian::CheckScript->new ("$ENV{'LINTIAN_ROOT'}/checks/",
+ 'files');
my $name = $cs->name;
foreach my $tag ($cs->tags) {
# $ti is an instance of Lintian::Tag::Info
@@ -63,23 +64,22 @@ common meta data of the check (such as Needs-Info).
=over 4
-=item Lintian::CheckScript->new ($file)
+=item Lintian::CheckScript->new ($basedir, $checkname)
Parses the $file as a check desc file.
=cut
sub new {
- my ($class, $file) = @_;
- my ($header, @tags) = read_dpkg_control ($file);
+ my ($class, $basedir, $checkname) = @_;
+ my ($header, @tags) = read_dpkg_control ("$basedir/${checkname}.desc");
my $self;
my $dir;
unless ($header->{'check-script'}) {
- croak "Missing Check-Script field in $file";
+ croak "Missing Check-Script field in $basedir/${checkname}.desc";
}
- $dir = realpath ($file)
- or croak "Cannot resolve $file: $!";
- $dir = dirname ($dir);
+ $dir = realpath ($basedir)
+ or croak "Cannot resolve $basedir: $!";
$self = {
'name' => $header->{'check-script'},
@@ -103,7 +103,8 @@ sub new {
for my $pg (@tags) {
my $ti;
- croak "Missing Tag field for tag in $file" unless $pg->{'tag'};
+ croak "Missing Tag field for tag in $basedir/${checkname}.desc"
+ unless $pg->{'tag'};
$ti = Lintian::Tag::Info->new($pg, $self->{'name'}, $self->{'type'});
$self->{'tag-table'}->{$ti->tag} = $ti;
}
@@ -131,9 +132,13 @@ lintian.desc, where this field is simply not present.
Returns the value of the Abbrev field from the desc file.
+=item $cs->script_path
+
+Returns the (expected) path to the script implementing this check.
+
=cut
-Lintian::CheckScript->mk_ro_accessors (qw(name type abbrev));
+Lintian::CheckScript->mk_ro_accessors (qw(name type abbrev script_path));
=item needs_info
diff --git a/lib/Lintian/Profile.pm b/lib/Lintian/Profile.pm
index f4841c5..1c905af 100644
--- a/lib/Lintian/Profile.pm
+++ b/lib/Lintian/Profile.pm
@@ -515,26 +515,26 @@ sub _check_for_invalid_fields {
sub _load_check {
my ($self, $profile, $check) = @_;
- my $desc = undef;
+ my $dir = undef;
foreach my $checkdir ($self->include_path ('checks')) {
my $cf = "$checkdir/${check}.desc";
if ( -f $cf ) {
- $desc = $cf;
+ $dir = $checkdir;
last;
}
}
- croak "$profile references unknown $check" unless defined $desc;
- $self->_parse_check ($desc, $check);
+ croak "$profile references unknown $check" unless defined $dir;
+ $self->_parse_check ($check, $dir);
}
sub _parse_check {
- my ($self, $desc, $gcname) = @_;
+ my ($self, $gcname, $dir) = @_;
# Have we already tried to load this before? Possibly via an alias
# or symlink
return $self->{'check-scripts'}->{$gcname}
if exists $self->{'check-scripts'}->{$gcname};
- my $c = Lintian::CheckScript->new ($desc);
+ my $c = Lintian::CheckScript->new ($dir, $gcname);
my $cname = $c->name;
if (exists $self->{'check-scripts'}->{$cname}) {
# We have loaded the check under a different name
@@ -565,7 +565,7 @@ sub _load_checks {
my $cname = $desc;
next unless $cname =~ s/\.desc$//o;
# _parse_check ignores duplicates, so we don't have to check for it.
- $self->_parse_check ("$checkdir/$desc", $cname);
+ $self->_parse_check ($cname, $checkdir);
}
closedir $dirfd;
}
diff --git a/lib/Test/Lintian.pm b/lib/Test/Lintian.pm
index c5a3a32..775244f 100644
--- a/lib/Test/Lintian.pm
+++ b/lib/Test/Lintian.pm
@@ -256,14 +256,16 @@ sub test_load_profiles {
File::Find::find (\%opt, $absdir);
}
-=item test_load_checks (DESCFILES...)
+=item test_load_checks (DIR, CHECKNAMES...)
Test that the Perl module implementation of the checks can be loaded
and has a run sub.
-DESCFILES is a list of paths in which to check desc files.
+DIR is the directory where the checks can be found.
+
+CHECKNAMES is a list of check names.
-For planning purposes, every element in DESCFILES counts for 2 tests.
+For planning purposes, every element in CHECKNAMES counts for 2 tests.
NB: This will load a profile if one hasn't been loaded already. This
is done to avoid issues loading L<data files|Lintian::Data> in the
@@ -273,21 +275,19 @@ L</load_profile_for_test ([PROFNAME[, INC...]])>)
=cut
sub test_load_checks {
- my (@descs) = @_;
+ my ($dir, @checknames) = @_;
my $builder = $CLASS->builder;
load_profile_for_test ();
- foreach my $desc (@descs) {
- my $cs = Lintian::CheckScript->new ($desc);
+ foreach my $checkname (@checknames) {
+ my $cs = Lintian::CheckScript->new ($dir, $checkname);
my $cname = $cs->name;
my $ppkg = $cname;
- my $path = $desc;
+ my $path = $cs->script_path;
my $err;
my $rs_ref = 'MISSING';
- $path =~ s,\.desc$,,o;
-
eval {
require $path;
};
@@ -314,10 +314,10 @@ sub test_load_checks {
}
}
-=item test_tags_implemented ([OPTS, ]DESCFILES...)
+=item test_tags_implemented ([OPTS, ], DIR, CHECKNAMES...)
Test a given check implements all the tags listed in its desc file.
-For planning purposes, each file listed in DESCFILES counts as one
+For planning purposes, each check listed in CHECKNAMES counts as one
test.
This is a simple scan of the source code looking asserting that the
@@ -326,8 +326,11 @@ Lintian's tags it is reliable enough to be useful. However it has
false-positives and false-negatives - the former can be handled via
"exclude-pattern" (see below).
+The DIR argument is the directory in which to find the checks.
+CHECKNAMES is a list of the check names.
+
The optional parameter OPTS is a hashref. If passed it must be the
-first argument. The followin key/value pairs are defined:
+first argument. The following key/value pairs are defined:
=over 4
@@ -363,15 +366,15 @@ alternative to the exclude-pattern (above).
=cut
sub test_tags_implemented {
- my ($opts, @descs);
+ my ($opts, $dir, @checknames);
my $pattern;
my $builder = $CLASS->builder;
if ($_[0] and ref $_[0] eq 'HASH') {
- ($opts, @descs) = @_;
+ ($opts, $dir, @checknames) = @_;
} else {
$opts = {};
- @descs = @_;
+ ($dir, @checknames) = @_;
}
if (exists $opts->{'exclude-pattern'}) {
@@ -382,14 +385,13 @@ sub test_tags_implemented {
}
}
- foreach my $desc (@descs) {
- my $cs = Lintian::CheckScript->new ($desc);
+ foreach my $checkname (@checknames) {
+ my $cs = Lintian::CheckScript->new ($dir, $checkname);
my $cname = $cs->name;
- my $check = $desc;
+ my $check = $cs->script_path;
my @tags = ();
my $codestr;
my @missing;
- $check =~ s/\.desc$//;
@tags = $cs->tags unless defined $pattern;
@tags = grep { !m/$pattern/ } $cs->tags
diff --git a/private/graph b/private/graph
index dee4b23..09ba0c4 100755
--- a/private/graph
+++ b/private/graph
@@ -82,7 +82,9 @@ if ($cond) {
if ($opt{'checks'}) {
foreach my $checkf (glob ("$LINTIAN_ROOT/checks/*.desc")) {
- my $check = Lintian::CheckScript->new ($checkf);
+ my $cname = $checkf;
+ $cname =~ s,^\Q$LINTIAN_ROOT\E/checks/(.+)\.desc$,$1,;
+ my $check = Lintian::CheckScript->new ("$LINTIAN_ROOT/checks", $cname);
my $name = $check->name;
my $n;
next if defined $opt{'pkg-type'} and not $check->is_check_type ($opt{'pkg-type'});
diff --git a/t/scripts/check-load.t b/t/scripts/check-load.t
index a998300..93b276e 100755
--- a/t/scripts/check-load.t
+++ b/t/scripts/check-load.t
@@ -26,9 +26,12 @@ use Test::Lintian;
# Test that all checks can be loaded (except lintian.desc, which is
# a special case).
-our @DESCS = (grep { !m,/lintian.desc$, } <$ENV{LINTIAN_ROOT}/checks/*.desc>);
+our @CHECKNAMES = map {
+ s,^\Q$ENV{'LINTIAN_ROOT'}\E/checks/(.+)\.desc$,$1,;
+ $_
+ } (grep { !m,/lintian.desc$, } <$ENV{LINTIAN_ROOT}/checks/*.desc>);
-plan tests => 2 * scalar @DESCS;
+plan tests => 2 * scalar @CHECKNAMES;
-test_load_checks (@DESCS);
+test_load_checks ("$ENV{'LINTIAN_ROOT'}/checks", @CHECKNAMES);
diff --git a/t/scripts/implemented-tags.t b/t/scripts/implemented-tags.t
index b2a9a6a..a6c0ce4 100755
--- a/t/scripts/implemented-tags.t
+++ b/t/scripts/implemented-tags.t
@@ -47,8 +47,13 @@ our $EXCLUDE =
# Find all of the check description files. We'll do one check per
# description. Exclude "lintian.desc" as it does not have a perl
# module like other checks.
-our @DESCS = (grep {!m,/lintian\.desc$, } <$ENV{LINTIAN_ROOT}/checks/*.desc>);
-plan tests => scalar @DESCS;
+our @CHECKNAMES = map {
+ s,^\Q$ENV{'LINTIAN_ROOT'}\E/checks/(.+)\.desc$,$1,;
+ $_
+ } (grep {!m,/lintian\.desc$, } <$ENV{LINTIAN_ROOT}/checks/*.desc>);
-test_tags_implemented ( {'exclude-pattern' => $EXCLUDE}, @DESCS);
+plan tests => scalar @CHECKNAMES;
+
+test_tags_implemented ( {'exclude-pattern' => $EXCLUDE},
+ "$ENV{LINTIAN_ROOT}/checks", @CHECKNAMES);
--
Debian package checker
Reply to: