[SCM] Debian package checker branch, master, updated. 2.2.10-20-g2b065d3
The following commit has been merged in the master branch:
commit 4b923a9b46b0f0f46ea530aa98d4343377f960d6
Author: Raphael Geissert <atomo64@gmail.com>
Date: Fri May 8 10:55:42 2009 -0500
Move the tags tests from tetset/runtests to their own test script
diff --git a/t/scripts/tags.t b/t/scripts/tags.t
new file mode 100644
index 0000000..2fac0ad
--- /dev/null
+++ b/t/scripts/tags.t
@@ -0,0 +1,69 @@
+#!/usr/bin/perl
+
+# Copyright (C) 1998 Richard Braakman
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, you can find it on the World Wide
+# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+use strict;
+use warnings;
+use Test::More qw(no_plan);
+use Util qw(read_dpkg_control);
+use Tags ();
+
+my @DESCS = <$ENV{'LINTIAN_ROOT'}/checks/*.desc>;
+
+my %severities = map { $_ => 1 } @Tags::severity_list;
+my %certainties = map { $_ => 1 } @Tags::certainty_list;
+
+for my $desc_file (@DESCS) {
+ for my $i (read_dpkg_control($desc_file)) {
+ $desc_file =~ s#.*/##;
+ if (exists $i->{'tag'}) {
+ ok($i->{'tag'} =~ /^[\w0-9.+-]+$/, "Tag has valid characters")
+ or diag("$desc_file: $i->{'tag'}\n");
+ ok(exists $i->{'info'}, "Tag has info")
+ or diag("$desc_file: $i->{'tag'}\n");
+
+ # Check the tag info for unescaped <> or for unknown tags (which
+ # probably indicate the same thing).
+ my $info = $i->{'info'} || '';
+ my @tags;
+ while ($info =~ s,<([^\s>]+)(?:\s+href=\"[^\"]+\")?>.*?</\1>,,s) {
+ push (@tags, $1);
+ }
+ my %known = map { $_ => 1 } qw(a em i tt);
+ my %seen;
+ @tags = grep { !$known{$_} && !$seen{$_}++ } @tags;
+ is(join(', ', @tags), '', 'Tag info has unknown html tags')
+ or diag("$desc_file: $i->{'tag'}\n");
+
+ ok($info !~ /[<>]/, "Tag info has no stray angle brackets")
+ or diag("$desc_file: $i->{'tag'}\n");
+
+ my $severity = $i->{'severity'};
+ my $certainty = $i->{'certainty'};
+ ok(!$severity || exists $severities{$severity}, "Tag has valid severity")
+ or diag("$desc_file: $i->{'tag'} severity: $severity\n");
+ ok(!$certainty || exists $certainties{$certainty}, "Tag has valid certainty")
+ or diag("$desc_file: $i->{'tag'} certainty: $certainty\n");
+ ok($severity, "Tag has severity")
+ or diag("$desc_file: $i->{'tag'}");
+ ok($certainty, "Tag has certainty")
+ or diag("$desc_file: $i->{'tag'}");
+ }
+ }
+}
diff --git a/testset/runtests b/testset/runtests
index 6a456de..00f7ab0 100755
--- a/testset/runtests
+++ b/testset/runtests
@@ -125,8 +125,6 @@ my $lintian_path = $LINTIAN_ROOT . "/frontend/lintian";
my $testok = 0;
my %tags;
-my %severities = map { $_ => 1 } @Tags::severity_list;
-my %certainties = map { $_ => 1 } @Tags::certainty_list;
# --- Display output immediately
$| = 1;
@@ -136,60 +134,11 @@ $| = 1;
-d $rundir
or fail("test directory $rundir does not exist\n");
-# does every tag have an info section?
-print "Checking for missing info tags ... ";
-
$testok = 1;
for my $desc_file (<$LINTIAN_ROOT/checks/*.desc>) {
for my $i (read_dpkg_control($desc_file)) {
$desc_file =~ s#.*/##;
if (exists $i->{'tag'}) {
- if ($i->{'tag'} !~ /^[\w0-9.+-]+$/) {
- print "E: test-tag-has-invalid-characters $i->{'tag'}"
- . " in $desc_file\n";
- }
- if (not exists $i->{'info'}) {
- print "E: test-has-no-info $i->{'tag'} in $desc_file\n";
- $testok = 0;
- }
-
- # Check the tag info for unescaped <> or for unknown tags (which
- # probably indicate the same thing).
- my $info = $i->{'info'};
- my @tags;
- while ($info =~ s,<([^\s>]+)(?:\s+href=\"[^\"]+\")?>.*?</\1>,,s) {
- push (@tags, $1);
- }
- my %known = map { $_ => 1 } qw(a em i tt);
- my %seen;
- @tags = grep { !$known{$_} && !$seen{$_}++ } @tags;
- if (@tags) {
- print "E: test-info-has-unknown-html-tags $i->{'tag'} @tags"
- . " in $desc_file\n";
- }
- if ($info =~ /[<>]/) {
- print "E: test-info-has-stray-angle-brackets $i->{'tag'}"
- . " in $desc_file\n";
- }
-
- my $severity = $i->{'severity'};
- my $certainty = $i->{'certainty'};
- if ($severity and not exists $severities{$severity}) {
- print "E: test-invalid-severity $severity in $desc_file\n";
- $testok = 0;
- next;
- }
- if ($certainty and not exists $certainties{$certainty}) {
- print "E: test-invalid-certainty $certainty in $desc_file\n";
- $testok = 0;
- next;
- }
- if (not $severity or not $certainty) {
- print "E: test-unclassified-tag $i->{'tag'} in $desc_file\n";
- $testok = 0;
- next;
- }
-
my $experimental = $i->{'experimental'};
my $code = Tags::get_tag_code($i);
$code = 'X' if $experimental and $experimental eq 'yes';
--
Debian package checker
Reply to: