Adding side stream changes to Maemian. Working to integrate full upstream libraries...
[maemian] / nokia-lintian / testset / runtests
diff --git a/nokia-lintian/testset/runtests b/nokia-lintian/testset/runtests
new file mode 100755 (executable)
index 0000000..0cd13de
--- /dev/null
@@ -0,0 +1,345 @@
+#!/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