+++ /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