#!/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] 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 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;
    } 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';
}

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';
my $lintian_info_options = '-I -i';
my $dpkg_buildpackage_options = '-rfakeroot -us -uc -d';
my $lintian_path = $LINTIAN_ROOT . "/frontend/lintian";

my $testok = 0;
my %tags;
my %types = ( 'E' => 'error', 'W' => 'warning', 'I' => 'info' );

# --- 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 (not exists $i->{'info'}) {
		print "E: test-has-no-info $i->{'tag'} in $desc_file\n";
		$testok = 0;
	    }
	    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;
	    $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>) {
	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: test-has-no-description $_ in $values->{'tested_package'}\n";
	$testok = 0;
    } elsif (not defined $values->{'tested_type'}) {
	print "I: test-is-not-tested $_ in $values->{'desc_file'}\n"
	    if $verbose;
    } elsif ($values->{'desc_type'} ne $values->{'tested_type'}) {
	print "E: test-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;
}

# vim: ts=8 sw=4
