From 75808db17caf8b960b351e3408e74142f4c85aac Mon Sep 17 00:00:00 2001 From: Daniel Baumann Date: Sun, 14 Apr 2024 15:42:30 +0200 Subject: Adding upstream version 2.117.0. Signed-off-by: Daniel Baumann --- lib/Lintian/Check/Testsuite.pm | 352 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 352 insertions(+) create mode 100644 lib/Lintian/Check/Testsuite.pm (limited to 'lib/Lintian/Check/Testsuite.pm') diff --git a/lib/Lintian/Check/Testsuite.pm b/lib/Lintian/Check/Testsuite.pm new file mode 100644 index 0000000..46556e5 --- /dev/null +++ b/lib/Lintian/Check/Testsuite.pm @@ -0,0 +1,352 @@ +# testsuite -- lintian check script -*- perl -*- + +# Copyright (C) 2013 Nicolas Boulenguez +# Copyright (C) 2017-2020 Chris Lamb +# Copyright (C) 2021 Felix Lechner + +# 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 . + +package Lintian::Check::Testsuite; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use List::Compare; +use List::SomeUtils qw(any none uniq); +use Path::Tiny; +use Unicode::UTF8 qw(encode_utf8); + +use Lintian::Deb822; +use Lintian::Deb822::Constants qw(DCTRL_COMMENTS_AT_EOL); +use Lintian::Relation; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +const my $DOT => q{.}; +const my $DOUBLE_QUOTE => q{"}; + +const my @KNOWN_FIELDS => qw( + Tests + Restrictions + Features + Depends + Tests-Directory + Test-Command + Architecture + Classes +); + +my %KNOWN_FEATURES = map { $_ => 1 } qw(); + +our $PYTHON3_ALL_DEPEND + = 'python3-all:any | python3-all-dev:any | python3-all-dbg:any'; + +my %KNOWN_SPECIAL_DEPENDS = map { $_ => 1 } qw( + @ + @builddeps@ + @recommends@ +); + +sub source { + my ($self) = @_; + + my $KNOWN_TESTSUITES= $self->data->load('testsuite/known-testsuites'); + + my $debian_control = $self->processable->debian_control; + + my $testsuite = $debian_control->source_fields->value('Testsuite'); + my @testsuites = split(/\s*,\s*/, $testsuite); + + my $lc = List::Compare->new(\@testsuites, [$KNOWN_TESTSUITES->all]); + my @unknown = $lc->get_Lonly; + + my $control_position + = $debian_control->source_fields->position('Testsuite'); + my $control_pointer = $debian_control->item->pointer($control_position); + + $self->pointed_hint('unknown-testsuite', $control_pointer, $_)for @unknown; + + my $tests_control + = $self->processable->patched->resolve_path('debian/tests/control'); + + # field added automatically since dpkg 1.17 when d/tests/control is present + $self->pointed_hint('unnecessary-testsuite-autopkgtest-field', + $control_pointer) + if (any { $_ eq 'autopkgtest' } @testsuites) && defined $tests_control; + + # need d/tests/control for plain autopkgtest + $self->pointed_hint('missing-tests-control', $control_pointer) + if (any { $_ eq 'autopkgtest' } @testsuites) && !defined $tests_control; + + die encode_utf8('debian tests control is not a regular file') + if defined $tests_control && !$tests_control->is_regular_file; + + if (defined $tests_control && $tests_control->is_valid_utf8) { + + # another check complains about invalid encoding + my $contents = $tests_control->decoded_utf8; + + my $control_file = Lintian::Deb822->new; + $control_file->parse_string($contents, DCTRL_COMMENTS_AT_EOL); + + my @sections = @{$control_file->sections}; + + $self->pointed_hint('empty-debian-tests-control', + $tests_control->pointer) + unless @sections; + + $self->check_control_paragraph($tests_control, $_) for @sections; + + my @thorough + = grep { $_->value('Restrictions') !~ m{\bsuperficial\b} } @sections; + $self->pointed_hint('superficial-tests', $tests_control->pointer) + if @sections && !@thorough; + + if (scalar @sections == 1) { + + my $section = $sections[0]; + + my $command = $section->unfolded_value('Test-Command'); + my $position = $section->position('Test-Command'); + my $pointer = $tests_control->pointer($position); + + $self->pointed_hint('no-op-testsuite', $pointer) + if $command =~ m{^ \s* (?:/bin/)? true \s* $}sx; + } + } + + my $control_autodep8 + = $self->processable->patched->resolve_path( + 'debian/tests/control.autodep8'); + $self->pointed_hint('debian-tests-control-autodep8-is-obsolete', + $control_autodep8->pointer) + if defined $control_autodep8; + + return; +} + +sub check_control_paragraph { + my ($self, $tests_control, $section) = @_; + + my $section_pointer = $tests_control->pointer($section->position); + + $self->pointed_hint('no-tests', $section_pointer) + unless $section->declares('Tests') || $section->declares('Test-Command'); + + $self->pointed_hint('conflicting-test-fields', $section_pointer, 'Tests', + 'Test-Command') + if $section->declares('Tests') && $section->declares('Test-Command'); + + my @lowercase_names = map { lc } $section->names; + my @lowercase_known = map { lc } @KNOWN_FIELDS; + + my $lc = List::Compare->new(\@lowercase_names, \@lowercase_known); + my @lowercase_unknown = $lc->get_Lonly; + + my @unknown = map { $section->literal_name($_) } @lowercase_unknown; + $self->pointed_hint('unknown-runtime-tests-field', + $tests_control->pointer($section->position($_)), $_) + for @unknown; + + my @features = $section->trimmed_list('Features', qr/ \s* , \s* | \s+ /x); + for my $feature (@features) { + + my $position = $section->position('Features'); + my $pointer = $tests_control->pointer($position); + + $self->pointed_hint('unknown-runtime-tests-feature',$pointer, $feature) + unless exists $KNOWN_FEATURES{$feature} + || $feature =~ m/^test-name=\S+/; + } + + my $KNOWN_RESTRICTIONS= $self->data->load('testsuite/known-restrictions'); + my $KNOWN_OBSOLETE_RESTRICTIONS + = $self->data->load('testsuite/known-obsolete-restrictions'); + + my @restrictions + = $section->trimmed_list('Restrictions', qr/ \s* , \s* | \s+ /x); + for my $restriction (@restrictions) { + + my $position = $section->position('Restrictions'); + my $pointer = $tests_control->pointer($position); + + $self->pointed_hint('unknown-runtime-tests-restriction', + $pointer, $restriction) + unless $KNOWN_RESTRICTIONS->recognizes($restriction); + + $self->pointed_hint('obsolete-runtime-tests-restriction', + $pointer, $restriction) + if $KNOWN_OBSOLETE_RESTRICTIONS->recognizes($restriction); + } + + my $test_command = $section->unfolded_value('Test-Command'); + + # trim both sides + $test_command =~ s/^\s+|\s+$//g; + + $self->pointed_hint('backgrounded-test-command', + $tests_control->pointer($section->position('Test-Command')), + $test_command) + if $test_command =~ / & $/x; + + my $directory = $section->unfolded_value('Tests-Directory') + || 'debian/tests'; + + my $tests_position = $section->position('Tests'); + my $tests_pointer = $tests_control->pointer($tests_position); + + my @tests = uniq +$section->trimmed_list('Tests', qr/ \s* , \s* | \s+ /x); + + my @illegal_names = grep { !m{^ [ [:alnum:] \+ \- \. / ]+ $}x } @tests; + $self->pointed_hint('illegal-runtime-test-name', $tests_pointer, $_) + for @illegal_names; + + my @paths; + if ($directory eq $DOT) { + + # Special case with "Tests-Directory: ." (see #849880) + @paths = @tests; + + } else { + @paths = map { "$directory/$_" } @tests; + } + + my $debian_control = $self->processable->debian_control; + + my $depends_norestriction = Lintian::Relation->new; + $depends_norestriction->load($section->unfolded_value('Depends')); + + my $all_tests_use_supported = 1; + + for my $path (@paths) { + + my $item = $self->processable->patched->resolve_path($path); + if (!defined $item) { + + $self->pointed_hint('missing-runtime-test-file', $tests_pointer, + $path); + next; + } + + if (!$item->is_open_ok) { + + $self->pointed_hint('runtime-test-file-is-not-a-regular-file', + $tests_pointer, $path); + next; + } + + my $queries_all_python_versions = 0; + + open(my $fd, '<', $item->unpacked_path) + or die encode_utf8('Cannot open ' . $item->unpacked_path); + + my $position = 1; + while (my $line = <$fd>) { + + my $pointer = $item->pointer($position); + + $self->pointed_hint('uses-deprecated-adttmp', $pointer) + if $line =~ /ADTTMP/; + + if ($line =~ /(py3versions)((?:\s+--?\w+)*)/) { + + my $command = $1 . $2; + my $options = $2; + + $self->pointed_hint( + 'runtime-test-file-uses-installed-python-versions', + $pointer, $command) + if $options =~ /\s(?:-\w*i|--installed)/; + + $self->pointed_hint( +'runtime-test-file-uses-supported-python-versions-without-test-depends', + $pointer, + $command + ) + if $options =~ /\s(?:-\w*s|--supported)/ + && !$depends_norestriction->satisfies($PYTHON3_ALL_DEPEND); + + $self->pointed_hint('declare-python-versions-for-test', + $pointer, $command) + if $options =~ m{ \s (?: -\w*r | --requested ) }x + && !$debian_control->source_fields->declares( + 'X-Python3-Version'); + + $queries_all_python_versions = 1 + if $options =~ m{ \s (?: -\w*s | --supported ) }x; + } + + } continue { + ++$position; + } + + close $fd; + + $all_tests_use_supported = 0 + if !$queries_all_python_versions; + + $self->pointed_hint('test-leaves-python-version-untested', + $item->pointer) + if $depends_norestriction->satisfies($PYTHON3_ALL_DEPEND) + && !$queries_all_python_versions; + } + + if ( $debian_control->source_fields->declares('X-Python3-Version') + && $all_tests_use_supported) { + + my $position + = $debian_control->source_fields->position('X-Python3-Version'); + my $pointer = $debian_control->item->pointer($position); + + $self->pointed_hint('drop-python-version-declaration',$pointer); + } + + if ($section->declares('Depends')) { + + my $depends = $section->unfolded_value('Depends'); + + # trim both sides + $depends =~ s/^\s+|\s+$//g; + + my $relation = Lintian::Relation->new->load($depends); + + # autopkgtest allows @ as predicate as an exception + my @unparsable = grep { !exists $KNOWN_SPECIAL_DEPENDS{$_} } + $relation->unparsable_predicates; + + my $position = $section->position('Depends'); + my $pointer = $tests_control->pointer($position); + + $self->pointed_hint('testsuite-dependency-has-unparsable-elements', + $pointer, $DOUBLE_QUOTE . $_ . $DOUBLE_QUOTE) + for @unparsable; + } + + return; +} + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et -- cgit v1.2.3