[SCM] Debian package checker branch, master, updated. 2.5.10-224-g7227da2
The following commit has been merged in the master branch:
commit 7227da2f67115454a2fb5fe74271070a167f39d6
Author: Niels Thykier <niels@thykier.net>
Date: Wed Oct 24 11:40:09 2012 +0200
T::L: Add test for implemented tags
Signed-off-by: Niels Thykier <niels@thykier.net>
diff --git a/lib/Test/Lintian.pm b/lib/Test/Lintian.pm
index 5cbe46c..cd44266 100644
--- a/lib/Test/Lintian.pm
+++ b/lib/Test/Lintian.pm
@@ -51,6 +51,7 @@ our @EXPORT = qw(
test_check_desc
test_load_checks
test_load_profiles
+ test_tags_implemented
);
use base 'Test::Builder::Module';
@@ -62,7 +63,7 @@ use Lintian::Check qw(check_spelling);
use Lintian::Data;
use Lintian::Profile;
use Lintian::Tags;
-use Lintian::Util qw(read_dpkg_control);
+use Lintian::Util qw(read_dpkg_control slurp_entire_file);
my %severities = map { $_ => 1 } @Lintian::Tags::SEVERITIES;
my %certainties = map { $_ => 1 } @Lintian::Tags::CERTAINTIES;
@@ -313,6 +314,107 @@ sub test_load_checks {
}
}
+=item test_tags_implemented ([OPTS, ]DESCFILES...)
+
+Test a given check implements all the tags listed in its desc file.
+For planning purposes, each file listed in DESCFILES counts as one
+test.
+
+This is a simple scan of the source code looking asserting that the
+tag names I<appear> (in the actual code part). For a vast majority of
+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 optional parameter OPTS is a hashref. If passed it must be the
+first argument. The followin key/value pairs are defined:
+
+=over 4
+
+=item exclude-pattern
+
+The value is assumed to be a regex (or a string describing a regex).
+Any tag matching this regex will be excluded from this test and is
+assumed to be implemented (regardless of whather that is true or not).
+
+This is useful for avoiding false-positives with cases like:
+
+ foreach my $x (@y) {
+ tag "some-tag-for-$x", "blah blah $x"
+ unless f($x);
+ }
+
+=back
+
+As mentioned, this test assert that the tag name appears in the code.
+Consider the following example:
+
+ my $tagname = 'my-tag';
+ $tagname = 'my-other-tag' if $condition;
+
+In this example, this test would conclude that 'my-tag' and
+'my-other-tag' are both implemented. Which is good when $tagname is
+eventually passed to L<tag|Lintian::Tags/tag>, and a false-negative
+otherwise.
+
+Comment lines are I<not> ignored, so comments can be used as an
+alternative to the exclude-pattern (above).
+
+=cut
+
+sub test_tags_implemented {
+ my ($opts, @descs);
+ my $pattern;
+ my $builder = $CLASS->builder;
+
+ if ($_[0] and ref $_[0] eq 'HASH') {
+ ($opts, @descs) = @_;
+ } else {
+ $opts = {};
+ @descs = @_;
+ }
+
+ if (exists $opts->{'exclude-pattern'}) {
+ if (ref $opts->{'exclude-pattern'} eq 'Regexp') {
+ $pattern = $opts->{'exclude-pattern'};
+ } else {
+ $pattern = qr/$opts->{'exclude-pattern'}/;
+ }
+ }
+
+ foreach my $desc (@descs) {
+ my $cs = Lintian::CheckScript->new ($desc);
+ my $cname = $cs->name;
+ my $check = $desc;
+ my @tags = ();
+ my $codestr;
+ my @missing;
+ $check =~ s/\.desc$//;
+
+ @tags = $cs->tags unless defined $pattern;
+ @tags = grep { !m/$pattern/ } $cs->tags
+ if defined $pattern;
+
+ # Any tags left to check?
+ unless (@tags) {
+ $builder->skip ("All tags $cname are excluded");
+ next;
+ }
+
+ $codestr = slurp_entire_file ($check);
+
+ # Might as well...
+ study $codestr;
+
+ for my $tag (@tags) {
+ push @missing, $tag unless $codestr =~ /\Q$tag/;
+ }
+
+ $builder->is_eq (join (', ', @missing), '',
+ "$cname has all tags implemented");
+ }
+}
+
=item load_profile_for_test ([PROFNAME[, INC...]])
Load a Lintian::Profile and ensure Data files can be used. This is
diff --git a/t/scripts/implemented-tags.t b/t/scripts/implemented-tags.t
index 9849499..b2a9a6a 100755
--- a/t/scripts/implemented-tags.t
+++ b/t/scripts/implemented-tags.t
@@ -19,7 +19,7 @@
use strict;
use Test::More;
-use Lintian::Util qw(read_dpkg_control slurp_entire_file);
+use Test::Lintian;
# Exclude the following tags, which are handled specially and can't be
# detected by this script.
@@ -38,7 +38,6 @@ our $EXCLUDE =
.*-address-causes-mail-loops-or-bounces$
^wrong-debian-qa-address-set-as-maintainer$
^wrong-debian-qa-group-name$
- ^malformed-override$
^example.*interpreter.*
^example-script-.*$
^example-shell-script-.*$
@@ -46,29 +45,10 @@ our $EXCLUDE =
));
# Find all of the check description files. We'll do one check per
-# description.
-our @DESCS = (<$ENV{LINTIAN_ROOT}/checks/*.desc>);
-plan tests => scalar(@DESCS);
+# 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;
+
+test_tags_implemented ( {'exclude-pattern' => $EXCLUDE}, @DESCS);
-# For each desc file, build a list of tags and then scan the corresponding
-# source code looking for use of that tag. The scanning is fairly
-# simple-minded.
-for my $desc (@DESCS) {
- my @tags = map { $_->{tag} || () } read_dpkg_control($desc);
- @tags = grep { !/$EXCLUDE/o } @tags;
- my $file;
- if ($desc =~ m,/lintian\.desc$,) {
- $file = "$ENV{LINTIAN_ROOT}/frontend/lintian";
- } else {
- $file = $desc;
- $file =~ s,\.desc$,,;
- }
- my $code = slurp_entire_file($file);
- my @missing;
- for my $tag (@tags) {
- push(@missing, $tag) unless $code =~ /\Q$tag/;
- }
- my $short = $desc;
- $short =~ s,^\Q$ENV{LINTIAN_ROOT}/*,,;
- is(join(', ', @missing), '', "$short has all tags implemented");
-}
--
Debian package checker
Reply to: