--- /dev/null
+#!/usr/bin/perl -w
+
+# 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;
+
+sub usage {
+ print <<END;
+Usage: $0 [-k] [-v] [-d] testset-directory testing-directory [test]
+
+The -k option means do not stop after one failed test, but try
+them all and report all errors.
+
+The -v option will also display those tests that have a description, but are
+not tested in any testset-package.
+
+The -d option will display debugging information.
+
+The optional 3rd parameter causes runtests to only run that particular test.
+END
+ exit 2;
+}
+
+# for debugging:
+my $debug = 0;
+
+# Tests layout:
+# Every test package is in a directory pkgname-version in the testset
+# directory. The lintian output that is expected for each package is
+# in a file tags.pkgname in the testset directory.
+
+# Running the tests:
+# Each test package is copied to a subdirectory of the testing-directory,
+# and built there. Then lintian is run over the resulting .changes file,
+# with its output redirected to tags.pkgname in the testing-directory.
+
+# If the tags output is not identical to the tags.pkgname file in the
+# testset-directory, then runtests will output the diff and exit with
+# a failure code.
+
+# The build output is directed to build.pkgname in the testing-directory.
+
+# Exit codes:
+# 0 - success
+# 1 - one or more tests failed
+# 2 - an error prevented proper running of the tests
+
+# Turns out I might as well have written this in bash. Oh well.
+
+my $run_all_tests = 0;
+my $verbose = 0;
+
+# --- Parse options, such as they are.
+while ($#ARGV >= 0 && $ARGV[0] =~ m/^-/) {
+ if ($ARGV[0] eq '-k') {
+ $run_all_tests = 1;
+ } elsif ($ARGV[0] eq '-v') {
+ $verbose = 1;
+ } elsif ($ARGV[0] eq '-d') {
+ $debug = 1;
+ } else {
+ usage;
+ }
+ shift;
+}
+
+# --- Parse directory arguments
+if ($#ARGV < 1 || $#ARGV > 2) {
+ usage;
+}
+
+my $testset = shift;
+my $rundir = shift;
+my $singletest;
+if ($#ARGV == 0) {
+ $singletest = shift;
+}
+
+# --- Set and unset environment variables that lintian is sensitive to
+BEGIN {
+ my $LINTIAN_ROOT = $ENV{'LINTIAN_ROOT'};
+ if (not $LINTIAN_ROOT) {
+ use Cwd ();
+ $ENV{'LINTIAN_ROOT'} = $LINTIAN_ROOT = Cwd::cwd();
+ }
+ delete $ENV{'LINTIAN_CFG'};
+ delete $ENV{'LINTIAN_LAB'};
+ delete $ENV{'LINTIAN_DIST'};
+ delete $ENV{'LINTIAN_UNPACK_LEVEL'};
+ $ENV{'LC_COLLATE'} = 'C';
+
+ # Set standard umask because many of the test packages rely on this
+ # when creating files from the debian/rules script.
+ umask(022);
+}
+
+my $LINTIAN_ROOT = $ENV{'LINTIAN_ROOT'};
+
+use lib "$ENV{'LINTIAN_ROOT'}/lib";
+use Util;
+use Tags;
+
+# --- Set the ways to call lintian and dpkg-buildpackage
+my $lintian_options = '-I -E';
+my $lintian_info_options = '-I -E -i';
+my $dpkg_buildpackage_options = '-rfakeroot -us -uc -d -iNEVER_MATCH_ANYTHING'
+ . ' -INEVER_MATCH_ANYTHING';
+my $lintian_path = $LINTIAN_ROOT . "/frontend/lintian";
+
+my $testok = 0;
+my %tags;
+my %types = ( 'E' => 'error', 'W' => 'warning', 'I' => 'info', 'X' => 'experimental' );
+
+# --- Display output immediately
+$| = 1;
+
+# --- Let's play.
+
+-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";
+ }
+
+ if (!exists($i->{'type'}) && !exists($i->{'severity'})) {
+ use Data::Dumper;
+ print Dumper $i;
+ print "E: test-has-no-type $i->{'tag'} in $desc_file\n";
+ $testok = 0;
+ next;
+ }
+
+ $tags{$i->{'tag'}}{'desc_file'} = $desc_file;
+ if (exists $i->{'experimental'}) {
+ $tags{$i->{'tag'}}{'desc_type'} = "experimental";
+ } else {
+ $tags{$i->{'tag'}}{'desc_type'} = $i->{'type'} ||
+ $Tags::sev_to_type[$i->{'severity'}];
+ }
+ }
+ }
+}
+
+if ($testok) {
+ print "done.\n";
+} else {
+ print "FAILED!\n";
+ exit 1 unless $run_all_tests;
+}
+
+# can I make a lab?
+print "Running static lab test ... create ... ";
+$testok = runsystem_ok("$lintian_path --lab $rundir/test_lab --setup-lab");
+# can I renew a lab?
+print " renew ... ";
+$testok = runsystem_ok("$lintian_path --lab $rundir/test_lab --setup-lab")
+ if $testok;
+# can I remove a lab?
+print " remove ...";
+$testok = runsystem_ok("$lintian_path --lab $rundir/test_lab --remove-lab")
+ if $testok;
+# should be empty now
+print " rmdir ...";
+$testok = runsystem_ok("rmdir $rundir/test_lab")
+ if $testok;
+# cleanup
+runsystem("rm -r $rundir/test_lab") if -d "$rundir/test_lab";
+if ($testok) {
+ print "done.\n";
+} else {
+ print "FAILED!\n";
+ exit 1 unless $run_all_tests;
+}
+
+# ok, I can make a static lab, now let's test the package checks
+# in temporary labs
+my @tests;
+if ($singletest) {
+ @tests = ( $singletest );
+} else {
+ opendir(TESTDIR, $testset)
+ or fail("cannot open $testset: $!\n");
+
+ @tests = sort(readdir(TESTDIR));
+
+ closedir(TESTDIR);
+}
+
+for (@tests) {
+ next if $_ eq '.' or $_ eq '..' or $_ eq 'CVS' or $_ eq '.svn';
+ next unless -d "$testset/$_";
+
+ my $pkgdir = $_;
+
+ open(CHANGELOG, "$testset/$pkgdir/debian/changelog") or
+ die("Could not open $testset/$pkgdir/debian/changelog");
+ my $line = <CHANGELOG>;
+ chomp($line);
+ close(CHANGELOG);
+ $line =~ s/^.*\(//;
+ $line =~ s/\).*$//;
+
+ my ($pkg, $ver) = ($pkgdir, $line);
+ print "Running test on $pkg $ver: copying... ";
+
+ print "Cleaning up and repopulating $rundir/$pkgdir...\n" if $debug;
+ runsystem_ok("rm -rf $rundir/$pkgdir");
+ runsystem("cp -rp $testset/$pkgdir $rundir");
+ opendir D, "$testset" or die;
+ foreach (readdir D) {
+ next unless /^\Q${pkg}\E_.*\.orig\.tar\.gz$/;
+ print "Symlinking $_ in $rundir...\n" if $debug;
+ symlink $ENV{'PWD'}."/$testset/$_", "$rundir/$_";
+ }
+ closedir D;
+ runsystem("find $rundir -name CVS -o -name .svn -print0 | xargs -0r rm -R");
+
+ print "building... ";
+ print "Running dpkg-buildpackage $dpkg_buildpackage_options in $rundir/$pkgdir...\n" if $debug;
+ runsystem("cd $rundir/$pkgdir && dpkg-buildpackage $dpkg_buildpackage_options >../build.$pkg 2>&1");
+
+ print "testing... ";
+ print "Running lintian $lintian_options on $rundir/$pkg\_$ver*.changes...\n" if $debug;
+ runsystem_ok("$lintian_path $lintian_options $rundir/$pkg\_$ver*.changes".
+ " 2>&1 | sort > $rundir/tags.$pkg");
+
+ # Run a sed-script if it exists, for tests that have slightly variable
+ # output
+ runsystem_ok("sed -i -f $testset/tags.$pkg.sed $rundir/tags.$pkg")
+ if -e "$testset/tags.$pkg.sed";
+
+ $testok = runsystem_ok("cmp -s $rundir/tags.$pkg $testset/tags.$pkg");
+ if ($testok) {
+ print "done.\n";
+ } else {
+ print "FAILED:\n";
+ runsystem_ok("diff -u $testset/tags.$pkg $rundir/tags.$pkg");
+ exit 1 unless $run_all_tests;
+ next;
+ }
+
+ open TAGS, "$rundir/tags.$pkg" or fail("Cannot open $rundir/tags.$pkg");
+ while (<TAGS>) {
+ next if /^N: /;
+ if (not /^(.): (\S+)(?: (?:source|udeb))?: (\S+)/) {
+ print "E: Invalid line:\n$_";
+ next;
+ }
+ $tags{$3}{'tested_type'} = $types{$1};
+ $tags{$3}{'tested_package'} = $2;
+ }
+ close TAGS;
+}
+
+print "Checking whether all tags are tested and tags have description ... \n";
+$testok = 1;
+for (keys %tags) {
+ my $values = $tags{$_};
+ if (not defined $values->{'desc_type'}) {
+ print "E: tag-has-no-description $_ in $values->{'tested_package'}\n";
+ $testok = 0;
+ } elsif (not defined $values->{'tested_type'}) {
+ print "I: tag-is-not-tested $_ in $values->{'desc_file'}\n"
+ if $verbose;
+ } elsif ($values->{'desc_type'} ne $values->{'tested_type'}) {
+ print "E: tag-has-inconsistent-type $_ $values->{'tested_type'} vs ".
+ "$values->{'desc_type'}\n";
+ $testok = 0;
+ }
+}
+
+if ($testok) {
+ print "done.\n";
+} else {
+ print "FAILED\n";
+ exit 1 unless $run_all_tests;
+}
+
+# --------------
+sub runsystem {
+ system(@_) == 0
+ or fail("failed: @_\n");
+}
+
+sub runsystem_ok {
+ my $errcode = system(@_);
+ $errcode == 0 or $errcode == (1 << 8)
+ or fail("failed: @_\n");
+ return $errcode == 0;
+}
+
+# Local Variables:
+# indent-tabs-mode: t
+# cperl-indent-level: 4
+# End:
+# vim: ts=8 sw=4