# testsuite -- lintian check script -*- perl -*-

# Copyright (C) 2013 Nicolas Boulenguez <nicolas@debian.org>

# This file is part of lintian.

# Lintian 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 3 of the License, or
# (at your option) any later version.

# Lintian 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 Lintian.  If not, see <http://www.gnu.org/licenses/>.

package Lintian::testsuite;

use strict;
use warnings;

use Lintian::Tags qw(tag);
use Lintian::Util qw(
    file_is_encoded_in_non_utf8
    read_dpkg_control
);

my @mandatory_fields = qw(
    tests
);
my %expected_fields = map { $_ => 1 } qw(
    tests
    restrictions
    features
    depends
    tests-directory
);
my %expected_features = map { $_ => 1 } qw(
);
my %expected_restrictions = map { $_ => 1 } qw(
    breaks-testbed
    build-needed
    needs-root
    rw-build-tree
);

sub run {
    my ($pkg, $type, $info) = @_;

    my $testsuite = $info->field ('testsuite');
    my $control = $info->index ('debian/tests/control');

    if (defined $testsuite xor defined $control) {
        tag 'inconsistent-testsuite-field';
    }
    if (defined $testsuite and $testsuite ne 'autopkgtest') {
        tag 'unknown-testsuite', $testsuite;
    }
    if (defined $control) {
        if (not $control->is_regular_file) {
            tag 'debian-tests-control-is-not-a-regular-file';
        } else {
            my $path = $info->unpacked ($control->name);

            my $not_utf8_line = file_is_encoded_in_non_utf8 ($path, $type, $pkg);
            if ($not_utf8_line) {
                tag 'debian-tests-control-uses-national-encoding', "at line $not_utf8_line";
            }

            check_control_contents ($info, $path);
        }
    }
}
sub check_control_contents {
    my ($info, $path) = @_;

    my @paragraphs;
    if (not eval { @paragraphs = read_dpkg_control ($path); }) {
        chomp $@;
        $@ =~ s/^syntax error at //;
        tag 'syntax-error-in-debian-tests-control', $@;
    } else {
        for (@paragraphs) {
            check_control_paragraph ($info, $_);
        }
    }
}
sub check_control_paragraph {
    my ($info, $paragraph) = @_;

    for (@mandatory_fields) {
        if (not exists $paragraph->{$_}) {
            tag 'missing-runtime-tests-field', $_;
        }
    }
    for (keys %$paragraph) {
        if (not exists $expected_fields {$_}) {
            tag 'unknown-runtime-tests-field', $_;
        }
    }
    if (exists $paragraph->{'features'}) {
        for (split ' ', $paragraph->{'features'}) {
            if (not exists $expected_features {$_}) {
                tag 'unknown-runtime-tests-feature', $_;
            }
        }
    }
    if (exists $paragraph->{'restrictions'}) {
        for (split ' ', $paragraph->{'restrictions'}) {
            if (not exists $expected_restrictions {$_}) {
                tag 'unknown-runtime-tests-restriction', $_;
            }
        }
    }
    if (exists $paragraph->{'tests'}) {
        my $directory;
        if (exists $paragraph->{'tests-directory'}) {
            $directory = $paragraph->{'tests-directory'};
        } else {
            $directory = 'debian/tests';
        }
        for (split ' ', $paragraph->{'tests'}) {
            check_test_file ($info, $directory, $_);
        }
    }
}
sub check_test_file {
    my ($info, $directory, $name) = @_;

    if ($name !~ /^[[:digit:][:lower:]\+\-\.\/]*$/) {
        tag 'illegal-runtime-test-name', $name;
    }
    my $path = "$directory/$name";
    my $index = $info->index ($path);
    if (not defined $index) {
        tag 'missing-runtime-test-file', $path;
    } elsif (not $index->is_regular_file) {
        tag 'runtime-test-file-is-not-a-regular-file', $path;
    }
    # Test files are allowed not to be executable.
}

1;
