[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index] [Thread Index]

[SCM] Debian package checker branch, master, updated. 2.5.10-214-g527df0f



The following commit has been merged in the master branch:
commit 527df0f9802fe34f596d88f22e04e1c3b5ed1204
Author: Niels Thykier <niels@thykier.net>
Date:   Sun Oct 21 11:25:12 2012 +0200

    Test::Lintian: New module to assist test writing
    
    Rename tags.t to check-descs.t and move all of its code into
    Test::Lintian, so others may reuse our test code for their own checks.
    
    Also correct two issues in the manual about the check desc file.
    
    Signed-off-by: Niels Thykier <niels@thykier.net>

diff --git a/doc/lintian.xml b/doc/lintian.xml
index d2b4c4a..fbe490d 100644
--- a/doc/lintian.xml
+++ b/doc/lintian.xml
@@ -1276,7 +1276,7 @@ foo [!any-i386] binary: some-tag-not-for-i386 optional-extra
               </listitem>
             </varlistentry>
             <varlistentry>
-              <term><emphasis>Needs-Info</emphasis> (simple, mandatory)</term>
+              <term><emphasis>Needs-Info</emphasis> (simple, optional)</term>
               <listitem>
                 <para>
                   Comma separated list of collections required for the
@@ -1327,6 +1327,7 @@ foo [!any-i386] binary: some-tag-not-for-i386 optional-extra
                   Name of the tag.  It must consist entirely of the
                   lower or/and upper case characters ([a-zA-Z]),
                   digits ([0-9]), underscore (_), dash (-) and period (.).
+                  The tag name should be at most 68 characters long.
                 </para>
               </listitem>
             </varlistentry>
diff --git a/lib/Test/Lintian.pm b/lib/Test/Lintian.pm
new file mode 100644
index 0000000..8d298a4
--- /dev/null
+++ b/lib/Test/Lintian.pm
@@ -0,0 +1,220 @@
+# Copyright (C) 1998 Richard Braakman
+# Copyright (C) 2012 Niels Thykier
+#
+# 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.
+
+package Test::Lintian;
+
+=head1 NAME
+
+Test::Lintian -- Check Lintian files for issues
+
+=head1 SYNOPSIS
+
+ use Test::Lintian;
+ use Test::More import => ['done_testing'];
+ 
+ load_profile_for_test ('vendor/profile', 'some/path/', '/usr/share/lintian');
+ test_check_desc (<./checks/vendor/*.desc>);
+ 
+ done_testing;
+
+=head1 DESCRIPTION
+
+A testing framework for testing various Lintian files for common
+errors.
+
+=cut
+
+use strict;
+use warnings;
+
+my $CLASS = __PACKAGE__;
+my $PROFILE = undef;
+our @EXPORT = qw(load_profile_for_test test_check_desc);
+
+use base 'Test::Builder::Module';
+
+use Lintian::Check qw(check_spelling);
+use Lintian::Data;
+use Lintian::Profile;
+use Lintian::Tags;
+use Lintian::Util qw(read_dpkg_control);
+
+my %severities = map { $_ => 1 } @Lintian::Tags::SEVERITIES;
+my %certainties = map { $_ => 1 } @Lintian::Tags::CERTAINTIES;
+my %check_types = map { $_ => 1 } qw(binary changes source udeb);
+my %known_html_tags = map { $_ => 1 } qw(a em i tt);
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item test_check_desc ([OPTS, ]DESCFILES...)
+
+Test check desc files (and the tags in them) for common errors.
+
+OPTS is an optional HASHREF that determines if some of the tests
+are optional or not.  Currently it is unused.
+
+DESCFILES is a list of paths to check desc files.
+
+As the number tests depend on the number of tags in desc, it is
+difficult to "plan ahead" when using this test.  It is therefore
+recommended to not specify a plan and use done_testing().
+
+This sub uses a Data file (see L</load_profile_for_test ([PROFNAME[, INC...]])>).
+
+=cut
+
+sub test_check_desc {
+    my ($opts, @descs);
+    my $builder = $CLASS->builder;
+
+    if (ref $_[0] eq 'HASH') {
+        $opts = shift;
+    }
+    $opts //= {};
+    @descs = @_;
+    load_profile_for_test ();
+
+    foreach my $desc_file (@descs) {
+        my ($header, @tagpara) = read_dpkg_control ($desc_file);
+        my $cname = $header->{'check-script'}//'';
+        my $ctype = $header->{'type'} // '';
+        my $cinfo = $header->{'info'} // '';
+        my $i = 1; # paragraph counter.
+        $builder->isnt_eq ($cname, '', "Check has a name ($desc_file)");
+        $cname = '<missing>' if $cname eq '';
+
+        if ($cname eq 'lintian') {
+            # skip these two tests for this special case...
+            $builder->skip ('Special case, check "lintian" does not have a type');
+            $builder->skip ('Special case, check "lintian" does not have a type');
+        } elsif ($builder->isnt_eq ($ctype, '', "$cname has a type")) {
+            my @bad = ();
+            # new lines are not allowed, map them to "\\n" for readability.
+            $ctype =~ s/\n/\\n/go;
+            foreach my $type (split m/\s*+,\s*+/o, $ctype) {
+                push @bad, $type unless exists $check_types{$type};
+            }
+            $builder->is_eq (join (', ', @bad), '', "The type of $cname is valid");
+        } else {
+            $builder->skip ("Cannot check type of $cname is valid (field is empty/missing)");
+        }
+
+        $builder->is_eq (check_spelling (undef, $cinfo), 0,
+                         "$cname Info has no spelling errors");
+
+        foreach my $tpara (@tagpara) {
+            my $tag = $tpara->{'tag'}//'';
+            my $severity = $tpara->{'severity'}//'';
+	    my $certainty = $tpara->{'certainty'}//'';
+            my $info = $tpara->{'info'} // '';
+            my @htmltags = ();
+            my %seen = ();
+
+            $i++;
+
+            # Tag name
+            $builder->isnt_eq ($tag, '', "Tag in check $cname has a name")
+                or $builder->diag ("$cname: Paragraph number $i\n");
+            $tag = '<N/A>' if $tag eq '';
+            $builder->ok ($tag =~ /^[\w0-9.+-]+$/, 'Tag has valid characters')
+		or $builder->diag ("$cname: $tag\n");
+            $builder->cmp_ok (length $tag, '<=', 68, 'Tag is not too long')
+                or $builder->diag ("$cname: $tag\n");
+
+            # Severity / Certainty
+	    $builder->ok (!$severity || exists $severities{$severity}, 'Tag has valid severity')
+		or $builder->diag ("$cname: $tag severity: $severity\n");
+	    $builder->ok (!$certainty || exists $certainties{$certainty}, 'Tag has valid certainty')
+		or $builder->diag ("$cname: $tag certainty: $certainty\n");
+
+            # Info
+            $builder->is_eq (check_spelling (undef, $info), 0,
+		"$cname: $tag has no spelling errors");
+
+            # Check the tag info for unescaped <> or for unknown tags (which
+	    # probably indicate the same thing).
+            while ($info =~ s,<([^\s>]+)(?:\s+href=\"[^\"]+\")?>.*?</\1>,,s) {
+		push @htmltags, $1;
+	    }
+            @htmltags = grep { !exists $known_html_tags{$_} && !$seen{$_}++ } @htmltags;
+            $builder->is_eq (join (', ', @htmltags), '', 'Tag info has no unknown html tags')
+		or $builder->diag ("$cname: $tag\n");
+
+            $builder->ok ($info !~ /[<>]/, 'Tag info has no stray angle brackets')
+		or $builder->diag ("$cname: $tag\n");
+
+            # TODO: Implement check of Ref (?)
+        }
+    }
+}
+
+=item load_profile_for_test ([PROFNAME[, INC...]])
+
+Load a Lintian::Profile and ensure Data files can be used.  This is
+needed if the test needs to access a data file or if a special profile
+is needed for the test.  It does I<not> test the profile for issues.
+
+PROFNAME is the name of the profile to load.  It can be omitted, in
+which case the sub ensures that a profile has been loaded.  If no
+profile has been loaded, 'debian/main' will be loaded.
+
+INC is a list of extra "include dirs" (or Lintian "roots") to be used
+for finding the profile.  If not specified, it defaults to
+I<$ENV{'LINTIAN_ROOT'}> and I</usr/share/lintian> (in order).  INC
+is ignored if a profile has already been loaded.
+
+CAVEAT: Only one profile can be loaded in a given test.  Once a
+profile has been loaded, it is not possible to replace it with another
+one.  So if this is invoked multiple times, PROFNAME must be omitted
+or must match the name of the loaded profile.
+
+=cut
+
+sub load_profile_for_test {
+    my ($profname, @inc) = @_;
+
+    # We have loaded a profile and are not asked to
+    # load a specific one - then current one will do.
+    return if $PROFILE and not $profname;
+
+    die "Cannot load two profiles.\n"
+        if $PROFILE and $PROFILE->name ne $profname;
+
+    return if $PROFILE; # Already loaded? stop here
+    # We just need it for spell checking, so debian/main should
+    # do just fine...
+    $profname ||= 'debian/main';
+
+    unless (@inc) {
+        push @inc, $ENV{'LINTIAN_ROOT'} if $ENV{'LINTIAN_ROOT'};
+        push @inc, '/usr/share/lintian' if -d '/usr/share/lintian';
+    }
+
+    $PROFILE = Lintian::Profile->new ($profname, \@inc);
+    Lintian::Data->set_vendor ($PROFILE);
+}
+
+
+=back
+
+=cut
+
+1;
diff --git a/collection/init.d b/t/scripts/check-descs.t
similarity index 52%
copy from collection/init.d
copy to t/scripts/check-descs.t
index ddc27d2..28e6654 100755
--- a/collection/init.d
+++ b/t/scripts/check-descs.t
@@ -1,18 +1,17 @@
-#!/usr/bin/perl -w
-# init.d -- lintian collector script
+#!/usr/bin/perl
 
-# Copyright (C) 1998 Richard Braakman
-# 
+# Copyright (C) 2012 Niels Thykier
+#
 # 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
@@ -22,27 +21,11 @@
 use strict;
 use warnings;
 
-use lib "$ENV{'LINTIAN_ROOT'}/lib";
-use Lintian::Util qw(copy_dir delete_dir fail);
+use Test::More import => ['done_testing'];
+use Test::Lintian;
 
-($#ARGV == 2) or fail('syntax: init.d <pkg> <type> <dir>');
-my ($pkg, $type, $dir) = @ARGV;
+load_profile_for_test ('debian/main', $ENV{'LINTIAN_ROOT'});
 
-if (-e "$dir/init.d") {
-    delete_dir ("$dir/init.d")
-        or fail('cannot rm old init.d directory');
-}
+test_check_desc (<$ENV{'LINTIAN_ROOT'}/checks/*.desc>);
 
-if (-d "$dir/unpacked/etc/init.d") {
-    copy_dir("$dir/unpacked/etc/init.d", "$dir/init.d")
-        or fail('cannot copy init.d directory');
-} else {
-    # no etc/init.d
-    mkdir ("$dir/init.d", 0777) or fail "cannot mkdir init.d: $!";
-}
-
-# Local Variables:
-# indent-tabs-mode: nil
-# cperl-indent-level: 4
-# End:
-# vim: syntax=perl sw=4 sts=4 sr et
+done_testing;
diff --git a/t/scripts/tags.t b/t/scripts/tags.t
deleted file mode 100755
index 61d6574..0000000
--- a/t/scripts/tags.t
+++ /dev/null
@@ -1,84 +0,0 @@
-#!/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 Lintian::Check qw(check_spelling);
-use Lintian::Data;
-use Lintian::Profile;
-use Lintian::Tags ();
-use Lintian::Util qw(read_dpkg_control);
-
-my $vendor = Lintian::Profile->new ('debian/main',
-                                 [$ENV{'LINTIAN_ROOT'}]);
-my @DESCS = <$ENV{'LINTIAN_ROOT'}/checks/*.desc>;
-
-my %severities = map { $_ => 1 } 'pedantic', @Lintian::Tags::SEVERITIES;
-my %certainties = map { $_ => 1 } @Lintian::Tags::CERTAINTIES;
-
-Lintian::Data->set_vendor ($vendor);
-
-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");
-	    cmp_ok(length($i->{'tag'}), '<=', 68, "Tag is not too long")
-		or diag("$desc_file: $i->{'tag'}\n");
-
-	    my $info = $i->{'info'} || '';
-
-	    is(check_spelling(undef, $info), 0,
-		"$desc_file: $i->{'tag'} has no spelling errors");
-
-	    # Check the tag info for unescaped <> or for unknown tags (which
-	    # probably indicate the same thing).
-	    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'}");
-	}
-    }
-}

-- 
Debian package checker


Reply to: