summaryrefslogtreecommitdiffstats
path: root/private/runtests
diff options
context:
space:
mode:
authorDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-14 13:42:30 +0000
committerDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-14 13:42:30 +0000
commit75808db17caf8b960b351e3408e74142f4c85aac (patch)
tree7989e9c09a4240248bf4658a22208a0a52d991c4 /private/runtests
parentInitial commit. (diff)
downloadlintian-75808db17caf8b960b351e3408e74142f4c85aac.tar.xz
lintian-75808db17caf8b960b351e3408e74142f4c85aac.zip
Adding upstream version 2.117.0.upstream/2.117.0upstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'private/runtests')
-rwxr-xr-xprivate/runtests972
1 files changed, 972 insertions, 0 deletions
diff --git a/private/runtests b/private/runtests
new file mode 100755
index 0000000..0b27fd7
--- /dev/null
+++ b/private/runtests
@@ -0,0 +1,972 @@
+#!/usr/bin/perl
+
+# Copyright (C) 1998 Richard Braakman
+# Copyright (C) 2008 Frank Lichtenheld
+# Copyright (C) 2008, 2009 Russ Allbery
+# Copyright (C) 2014 Niels Thykier
+# Copyright (C) 2020 Felix Lechner
+#
+# 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 https://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+# The harness for Lintian's test suite. For detailed information on
+# the test suite layout and naming conventions, see t/tests/README.
+# For more information about running tests, see
+# doc/tutorial/Lintian/Tutorial/TestSuite.pod
+#
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Const::Fast;
+use Cwd qw(realpath);
+use File::Basename qw(dirname);
+
+# neither Path::This nor lib::relative are in Debian
+use constant THISFILE => realpath __FILE__;
+use constant THISDIR => dirname realpath __FILE__;
+
+# use Lintian modules that belong to this program
+use lib THISDIR . '/../lib';
+
+use Capture::Tiny qw(capture_merged);
+use Cwd qw(getcwd);
+use File::Copy;
+use File::Find::Rule;
+use File::Path qw(make_path);
+use File::Spec::Functions qw(abs2rel rel2abs splitpath splitdir);
+use File::stat;
+use Getopt::Long;
+use IPC::Run3;
+use List::Compare;
+use List::SomeUtils qw(any uniq);
+use List::Util qw(max);
+use IO::Interactive qw(is_interactive);
+use IO::Prompt::Tiny qw(prompt);
+use MCE::Loop;
+use Path::Tiny;
+use Syntax::Keyword::Try;
+use TAP::Formatter::Console;
+use TAP::Formatter::File;
+use TAP::Harness;
+use TAP::Parser::Aggregator;
+use Term::ANSIColor;
+use Time::Duration;
+use Time::Moment;
+use Time::Piece;
+use Unicode::UTF8 qw(encode_utf8 decode_utf8);
+
+use Lintian::IPC::Run3 qw(safe_qx);
+
+use Test::Lintian::Build qw(build_subject);
+use Test::Lintian::ConfigFile qw(read_config);
+use Test::Lintian::Filter
+ qw(find_selected_scripts find_selected_lintian_testpaths);
+use Test::Lintian::Helper
+ qw(rfc822date cache_dpkg_architecture_values get_latest_policy get_recommended_debhelper_version);
+use Test::Lintian::Hooks qw(sed_hook sort_lines calibrate);
+use Test::Lintian::Prepare qw(filleval prepare);
+use Test::Lintian::Run qw(logged_runner);
+use Test::ScriptAge qw(perl_modification_epoch our_modification_epoch);
+
+const my $EMPTY => q{};
+const my $SPACE => q{ };
+const my $INDENT => $SPACE x 4;
+const my $NEWLINE => qq{\n};
+const my $SLASH => q{/};
+const my $COMMA => q{,};
+const my $COLON => q{:};
+const my $ARROW => q{>>>};
+const my $YES => q{yes};
+const my $NO => q{no};
+
+const my $WIDELY_READABLE => oct(22);
+
+# display output immediately
+STDOUT->autoflush;
+
+# something changes the default handler, see Bug#974575
+$SIG{WINCH} = 'DEFAULT';
+
+# see https://stackoverflow.com/a/60761593
+$SIG{CHLD} ||= 'DEFAULT';
+$SIG{HUP} ||= 'DEFAULT';
+
+my $processing_start = Time::Moment->from_string(gmtime->datetime . 'Z');
+
+# whitelist the environment we permit to avoid things that mess up
+# tests, like CFLAGS, DH_OPTIONS, DH_COMPAT, DEB_HOST_ARCH
+my %PRESERVE_ENV = map { $_ => 1 } qw(
+ LINTIAN_TEST_INSTALLED
+ PATH
+ TMPDIR
+);
+
+my @disallowed = grep { !exists $PRESERVE_ENV{$_} } keys %ENV;
+
+delete $ENV{$_} for @disallowed;
+
+if (($ENV{LINTIAN_TEST_INSTALLED} // 'no') eq 'yes') {
+
+ $ENV{LINTIAN_UNDER_TEST} = realpath('/usr/bin/lintian')
+ // die encode_utf8('Lintian is not installed');
+
+} else {
+ $ENV{LINTIAN_UNDER_TEST} = realpath(THISDIR . '/../bin/lintian');
+}
+
+$ENV{LINTIAN_BASE}= realpath(dirname(dirname($ENV{LINTIAN_UNDER_TEST})))
+ // die encode_utf8('Cannot resolve LINTIAN_BASE');
+
+# options
+my $coverage;
+my $debug;
+my $dump_logs = 1;
+my $force_rebuild;
+my $numjobs;
+my $keep_going;
+my $onlyrun;
+my $outpath;
+my $unattended;
+my $verbose = 0;
+
+Getopt::Long::Configure('bundling');
+unless (
+ Getopt::Long::GetOptions(
+ 'B|force-rebuild' => \$force_rebuild,
+ 'c|coverage:s' => \$coverage,
+ 'd|debug+' => \$debug,
+ 'j|jobs:i' => \$numjobs,
+ 'k|keep-going' => \$keep_going,
+ 'L|dump-logs!' => \$dump_logs,
+ 'o|onlyrun:s' => \$onlyrun,
+ 'u|unattended' => \$unattended,
+ 'v|verbose' => \$verbose,
+ 'w|work-dir:s' => \$outpath,
+ 'h|help' => sub {usage(); exit;},
+ )
+) {
+ usage();
+ die;
+}
+
+# check number of arguments
+die encode_utf8('Please use -h for usage information.')
+ if @ARGV > 1;
+
+# get arguments
+my ($testset) = @ARGV;
+
+# default test set
+$testset ||= 't';
+
+# check test set directory
+die encode_utf8("Cannot find testset directory $testset")
+ unless -d $testset;
+
+# make sure testset is an absolute path
+$testset = rel2abs($testset);
+
+# calculate a default test work directory if none given
+$outpath ||= dirname($testset) . '/debian/test-out';
+
+# create test work directory unless it exists
+make_path($outpath)
+ unless -e $outpath;
+
+# make sure test work path is a directory
+die encode_utf8("Test work directory $outpath is not a directory")
+ unless -d $outpath;
+
+# make sure outpath is absolute
+$outpath = rel2abs($outpath);
+
+my $ACTIVE_JOBS = 0;
+
+# get lintian modification date
+my @lintianparts
+ = ('checks', 'commands', 'data','bin', 'profiles', 'vendors', 'lib/Lintian');
+my @lintianfiles
+ = map { File::Find::Rule->file->in("$ENV{'LINTIAN_BASE'}/$_") }@lintianparts;
+push(@lintianfiles, Cwd::realpath($ENV{'LINTIAN_UNDER_TEST'}));
+$ENV{'LINTIAN_EPOCH'}
+ = max(map { -e ? path($_)->stat->mtime : time } @lintianfiles);
+say encode_utf8('Lintian modified on '. rfc822date($ENV{'LINTIAN_EPOCH'}));
+
+my $lintian_error;
+my $bytes = capture_merged {
+ my @command = ($ENV{'LINTIAN_UNDER_TEST'}, '--version');
+ system(@command) == 0
+ or $lintian_error = "system @command failed: $?";
+};
+my $string = decode_utf8($bytes);
+die encode_utf8($string . $lintian_error)
+ if length $lintian_error;
+
+chomp $string;
+my ($version) = $string =~ qr/^\S+\s+v(.+)$/;
+die encode_utf8('Cannot get Lintian version') unless length $version;
+say encode_utf8("Version under test is $version.");
+
+say encode_utf8($EMPTY);
+
+# set environment for coverage
+if (defined $coverage) {
+ # Only collect coverage for stuff that D::NYTProf and
+ # Test::Pod::Coverage cannot do for us. This makes cover use less
+ # RAM in the other end.
+ my @criteria = qw(statement branch condition path subroutine);
+ my $args= '-MDevel::Cover=-silent,1,+ignore,^(.*/)?t/scripts/.+';
+ $args .= ',+ignore,/usr/bin/.*,+ignore,(.*/)?Dpkg';
+ $args .= ',-coverage,' . join(',-coverage,', @criteria);
+ $args .= $COMMA . $coverage if $coverage ne $EMPTY;
+ $ENV{'LINTIAN_COVERAGE'} = $args;
+
+ $ENV{'HARNESS_PERL_SWITCHES'} //= $EMPTY;
+ $ENV{'HARNESS_PERL_SWITCHES'} .= $SPACE . $args;
+}
+
+# Devel::Cover + one cover_db + multiple processes is a recipe
+# for corruptions. Force $numjobs to 1 if we are running under
+# coverage.
+$numjobs = 1 if exists $ENV{'LINTIAN_COVERAGE'};
+
+# tie verbosity to debug
+$verbose = 1 + $debug if $debug;
+
+# can be 0 without value ("-j") or undef if option was not specified at all
+$numjobs ||= default_parallel();
+say encode_utf8("Running up to $numjobs tests concurrently")
+ if $numjobs > 1 && $verbose >= 2;
+
+$ENV{'DUMP_LOGS'} = $dump_logs//$NO ? $YES : $NO;
+
+# Disable translation support in dpkg as it is a considerable
+# unnecessary overhead.
+$ENV{'DPKG_NLS'} = 0;
+
+my $helperpath = "$testset/../private";
+if (-d $helperpath) {
+ my $helpers = rel2abs($helperpath)
+ // die encode_utf8("Cannot resolve $helperpath: $!");
+ $ENV{'PATH'} = "$helpers:$ENV{'PATH'}";
+}
+
+# get architecture
+cache_dpkg_architecture_values();
+say encode_utf8("Host architecture is $ENV{'DEB_HOST_ARCH'}.");
+
+# get latest policy version and date
+($ENV{'POLICY_VERSION'}, $ENV{'POLICY_EPOCH'}) = get_latest_policy();
+say encode_utf8("Latest policy version is $ENV{'POLICY_VERSION'} from "
+ . rfc822date($ENV{'POLICY_EPOCH'}));
+
+# get current debhelper compat level; do not name DH_COMPAT; causes conflict
+$ENV{'DEFAULT_DEBHELPER_COMPAT'} = get_recommended_debhelper_version();
+say encode_utf8(
+"Using compat level $ENV{'DEFAULT_DEBHELPER_COMPAT'} as a default for packages built with debhelper."
+);
+
+# get harness date, including templates, skeletons and whitelists
+my @harnessparts
+ = ('bin', 't/defaults', 't/templates', 't/skeletons', 't/whitelists');
+my @harnessfiles
+ = map { File::Find::Rule->file->in("$ENV{'LINTIAN_BASE'}/$_") }@harnessparts;
+my $harness_files_epoch
+ = max(map { -e ? path($_)->stat->mtime : time } @harnessfiles);
+$ENV{'HARNESS_EPOCH'}
+ = max(our_modification_epoch, perl_modification_epoch, $harness_files_epoch);
+say encode_utf8('Harness modified on '. rfc822date($ENV{'HARNESS_EPOCH'}));
+
+say encode_utf8($EMPTY);
+
+# print environment
+my @vars = sort keys %ENV;
+say encode_utf8('Environment:') if @vars;
+for my $var (@vars) { say encode_utf8($INDENT . "$var=$ENV{$var}") }
+
+say encode_utf8($EMPTY);
+
+my $status = 0;
+
+my $formatter = TAP::Formatter::File->new(
+ {
+ errors => 1,
+ jobs => $numjobs,
+ }
+);
+$formatter = TAP::Formatter::Console->new(
+ {
+ errors => 1,
+ jobs => $numjobs,
+ color => 1,
+ }
+) if is_interactive;
+
+my $harness = TAP::Harness->new(
+ {
+ formatter => $formatter,
+ jobs => $numjobs,
+ lib => ["$ENV{'LINTIAN_BASE'}/lib"],
+ }
+);
+
+my $aggregator = TAP::Parser::Aggregator->new;
+$aggregator->start;
+
+my @runscripts;
+my $allscripts_path = "$testset/scripts";
+
+# add selected scripts
+push(@runscripts, find_selected_scripts($allscripts_path, $onlyrun));
+
+# always add internal harness tests
+my @requiredscripts;
+@requiredscripts
+ = sort File::Find::Rule->file()->name('*.t')->in("$allscripts_path/harness")
+ unless length $onlyrun;
+push(@runscripts, @requiredscripts);
+
+# remove any duplicates
+@runscripts = uniq @runscripts;
+
+# make all paths relative
+@runscripts = map { abs2rel($_) } @runscripts;
+
+say encode_utf8('Running selected and required Perl test scripts.');
+say encode_utf8($EMPTY);
+
+# run scripts through harness
+$harness->aggregate_tests($aggregator, sort @runscripts);
+
+if (@runscripts && !$aggregator->all_passed && !$keep_going) {
+ $aggregator->stop;
+ $formatter->summary($aggregator);
+ exit 1;
+}
+
+say encode_utf8($EMPTY);
+
+my @testpaths = find_selected_lintian_testpaths($testset, $onlyrun);
+
+my $recipe_root = "$testset/recipes";
+
+# find test paths
+my @recipes = map { path($_)->relative($recipe_root)->stringify }@testpaths;
+
+# prepare output directories
+say encode_utf8(
+ 'Preparing the sources for '. scalar @recipes. ' test packages.')
+ if @recipes;
+
+# for filled templates
+my $source_root = "$outpath/package-sources";
+
+# for built test packages
+my $build_root = "$outpath/packages";
+
+# find build specifications
+my @all_recipes = map { path($_)->parent->stringify }
+ sort File::Find::Rule->relative->name('build-spec')->in($recipe_root);
+
+my @source_paths
+ = map { path($_)->absolute($source_root)->stringify } @all_recipes;
+my @build_paths
+ = map { path($_)->absolute($build_root)->stringify } @all_recipes;
+
+# remove obsolete package sources
+my @found_sources = map { path($_)->parent->absolute->stringify; }
+ File::Find::Rule->file->name('fill-values')->in($source_root);
+my $sourcelc = List::Compare->new(\@found_sources, \@source_paths);
+my @obsolete_sources = $sourcelc->get_Lonly;
+path($_)->remove_tree for @obsolete_sources;
+
+# remove obsolete built packages
+my @found_builds = map { path($_)->parent->absolute->stringify; }
+ File::Find::Rule->file->name('source-files.sha1sums')->in($build_root);
+my $packagelc= List::Compare->new(\@found_builds, \@build_paths);
+my @obsolete_builds = $packagelc->get_Lonly;
+path($_)->remove_tree for @obsolete_builds;
+
+# remove empty directories
+for my $folder (@obsolete_sources, @obsolete_builds) {
+ my $candidate = path($folder)->parent;
+ while ($candidate->exists && !$candidate->children) {
+ rmdir $candidate->stringify;
+ $candidate = $candidate->parent;
+ }
+}
+
+$ENV{PERL_PATH_TINY_NO_FLOCK} =1;
+
+$SIG{INT} = sub { MCE::Loop->finish; die encode_utf8("Caught a sigint $!") };
+my $mce_loop = MCE::Loop->init(
+ max_workers => $numjobs,
+ chunk_size => 1,
+ flush_stdout => 1,
+ flush_stderr => 1,
+);
+
+my %failedprep = mce_loop {
+ my ($mce, $chunk_ref, $chunk_id) = @_;
+
+ prepare_build($mce, $_);
+}
+@recipes;
+
+if (%failedprep) {
+ say encode_utf8($EMPTY);
+ say encode_utf8('Failed preparation tasks:');
+ for my $recipe (sort keys %failedprep) {
+ say encode_utf8($EMPTY);
+ say encode_utf8($ARROW
+ . $SPACE
+ . path("$recipe_root/$recipe")->relative->stringify
+ . $COLON);
+ print encode_utf8($failedprep{$recipe});
+ }
+
+ MCE::Loop->finish;
+ exit 1;
+
+} else {
+ say encode_utf8('Package sources are ready.');
+}
+
+say encode_utf8($EMPTY);
+
+my %failedbuilds = mce_loop {
+ my ($mce, $chunk_ref, $chunk_id) = @_;
+
+ build_package($mce, $_, $chunk_id, scalar @recipes);
+}
+@recipes;
+
+$SIG{INT} = 'DEFAULT';
+MCE::Loop->finish;
+
+if (%failedbuilds) {
+ say encode_utf8($EMPTY);
+ say encode_utf8('Failed build tasks:');
+ for my $recipe (sort keys %failedbuilds) {
+ say encode_utf8($EMPTY);
+ say encode_utf8($ARROW
+ . $SPACE
+ . path("$recipe_root/$recipe")->relative->stringify
+ . $COLON);
+ print encode_utf8($failedbuilds{$recipe});
+ }
+
+ exit 1;
+} else {
+ say encode_utf8('All test packages are up to date.');
+}
+
+say encode_utf8($EMPTY);
+
+my $build_end = Time::Moment->from_string(gmtime->datetime . 'Z');
+my $build_duration = duration($processing_start->delta_seconds($build_end));
+say encode_utf8("Building the test packages took $build_duration.");
+
+say encode_utf8($EMPTY);
+
+# for built test packages
+my $buildroot = "$outpath/packages";
+
+# for built test packages
+my $evalroot = "$outpath/eval";
+
+$SIG{INT} = sub { MCE::Loop->finish; die encode_utf8("Caught a sigint $!") };
+
+mce_loop {
+ my ($mce, $chunk_ref, $chunk_id) = @_;
+
+ prepare_test($mce, $_);
+}
+sort @testpaths;
+
+MCE::Loop->finish;
+
+$SIG{INT} = 'DEFAULT';
+
+# remap paths from testset to outpath to get work directories
+my @workpaths
+ = map { rel2abs(abs2rel($_, "$testset/recipes"), "$outpath/eval") }
+ @testpaths;
+
+# if ($platforms ne 'any') {
+# my @wildcards = split(/$SPACE/, $platforms);
+# my @matches= map {
+# decode_utf8(qx{dpkg-architecture -a $ENV{'DEB_HOST_ARCH'} -i $_; echo -n \$?})
+# } @wildcards;
+# unless (any { $_ == 0 } @matches) {
+# say encode_utf8('Architecture mismatch');
+# return;
+# }
+# }
+
+# make all paths relative to current directory
+@workpaths = map { path($_)->relative } @workpaths;
+
+# add the scripts in generated tests to be run
+my @workscripts;
+for my $path (@workpaths) {
+
+ my @runners = File::Find::Rule->file->name('*.t')->in($path);
+
+ die encode_utf8("No runner in $path")
+ unless scalar @runners;
+ die encode_utf8("More than one runner in $path")
+ if scalar @runners > 1;
+
+ push(@workscripts, @runners);
+}
+
+# run scripts through harness
+$harness->aggregate_tests($aggregator, sort @workscripts);
+
+$aggregator->stop;
+$formatter->summary($aggregator);
+
+say encode_utf8($EMPTY);
+
+my $test_end = Time::Moment->from_string(gmtime->datetime . 'Z');
+my $test_duration = duration($processing_start->delta_seconds($test_end));
+say encode_utf8("The test suite ran for $test_duration.");
+
+$status = 1
+ unless $aggregator->all_passed;
+
+if (is_interactive && !$unattended) {
+ my @failed = $aggregator->failed;
+ say encode_utf8(
+ 'Offering to re-calibrate the hints expected in tests that failed.')
+ if @failed;
+
+ my $accept_all;
+
+ for my $scriptpath (@failed) {
+ my $workpath = dirname($scriptpath);
+
+ my $descpath = "$workpath/desc";
+ my $testcase = read_config($descpath);
+
+ my $relative = abs2rel($workpath, $evalroot);
+ my $testpath = abs2rel(rel2abs($relative, "$testset/recipes"));
+
+ say encode_utf8($EMPTY);
+ say encode_utf8(
+ 'Failed test: ' . colored($testpath, 'bold white on_blue'));
+
+ my $match_strategy = $testcase->unfolded_value('Match-Strategy');
+
+ if ($match_strategy eq 'hints') {
+
+ my $diffpath = "$workpath/hintdiff";
+ next
+ unless -r $diffpath;
+
+ my $diff = path($diffpath)->slurp_utf8;
+ print encode_utf8($diff);
+
+ } elsif ($match_strategy eq 'literal') {
+
+ my $actualpath = "$workpath/literal.actual.parsed";
+ next
+ unless -r $actualpath;
+ my @command
+ = ('diff', '-uN', "$testpath/eval/literal", $actualpath);
+ say encode_utf8(join($SPACE, @command));
+ system(@command);
+
+ } else {
+ say encode_utf8(
+"Do not know how to fix tests using matching strategy $match_strategy."
+ );
+ next;
+ }
+
+ unless ($accept_all) {
+
+ my $decision_bytes = prompt(
+ encode_utf8(
+'>>> Fix test (y), accept all (a), do not fix (n), quit (q/default)?'
+ )
+ );
+ my $decision = decode_utf8($decision_bytes);
+
+ last
+ if $decision eq 'q' || $decision eq $EMPTY;
+
+ next
+ unless $decision eq 'y' || $decision eq 'a';
+
+ $accept_all = 1
+ if $decision eq 'a';
+ }
+
+ if ($match_strategy eq 'hints') {
+
+ # create hints if needed; helps when writing new tests
+ my $hintspath = "$testpath/eval/hints";
+ path($hintspath)->touch
+ unless -e $hintspath;
+
+ my $diffpath = "$workpath/hintdiff";
+ next
+ unless -r $diffpath;
+
+ my @adjustargs = ($diffpath, $hintspath);
+ unshift(@adjustargs, '-i')
+ unless $accept_all;
+
+ die encode_utf8("Cannot run hintadjust for $testpath")
+ if system('hintadjust', @adjustargs);
+
+ # also copy the new hints to workpath; no need to rebuild
+ die encode_utf8("Cannot copy updated hints to $workpath")
+ if system('cp', $hintspath, "$workpath/hints");
+
+ } elsif ($match_strategy eq 'literal') {
+
+ my $actualpath = "$workpath/literal.actual.parsed";
+ next
+ unless -r $actualpath;
+
+ die encode_utf8(
+ "Cannot copy to accept literal output for $testpath")
+ if system('cp', $actualpath, "$testpath/eval/literal");
+
+ }
+ }
+
+ say encode_utf8($NEWLINE . 'Accepted all remaining hint changes.')
+ if $accept_all;
+
+} else {
+ my @crashed = $aggregator->parse_errors;
+
+ say encode_utf8('Showing full logs for tests with parse errors.')
+ if @crashed;
+
+ for my $absolutepath (@crashed) {
+
+ my $scriptpath = abs2rel($absolutepath);
+ my $workpath = dirname($scriptpath);
+ my $logpath = "$workpath/log";
+
+ next
+ unless -e $logpath;
+
+ say encode_utf8($EMPTY);
+ say encode_utf8("Log for test $scriptpath:");
+
+ my $log = path($logpath)->slurp_utf8;
+ print encode_utf8($log);
+ }
+}
+
+# give a hint if not enough tests were run
+unless (scalar @runscripts - scalar @requiredscripts + scalar @workscripts
+ || $onlyrun eq 'minimal:') {
+ quick_hint($onlyrun);
+ exit 1;
+}
+
+say encode_utf8($EMPTY);
+
+exit $status;
+
+# program is done
+
+sub prepare_build {
+ my ($mce, $recipe) = @_;
+
+ # label process
+ $0 = "Lintian prepare test: $recipe";
+
+ # destination
+ my $source_path = "$source_root/$recipe";
+
+ my $error;
+
+ # capture output
+ my $log_bytes =capture_merged {
+
+ try {
+
+ # remove destination
+ path($source_path)->remove_tree
+ if -e $source_path;
+
+ # prepare
+ prepare("$recipe_root/$recipe/build-spec",
+ $source_path, $testset, $force_rebuild);
+
+ } catch {
+ # catch any error
+ $error = $@;
+ }
+ };
+
+ my $log = decode_utf8($log_bytes);
+
+ # save log;
+ my $logfile = "$source_path.log";
+ path($logfile)->spew_utf8($log) if $log;
+
+ $mce->gather($recipe, $error)
+ if length $error;
+
+ return;
+}
+
+sub build_package {
+ my ($mce, $recipe, $position, $total) = @_;
+
+ # set a predictable locale
+ $ENV{'LC_ALL'} = 'C';
+
+ # many tests create files via debian/rules
+ umask $WIDELY_READABLE;
+
+ # get destination
+ my $source_path = "$source_root/$recipe";
+ my $build_path = "$build_root/$recipe";
+
+ my $savedir = getcwd;
+ chdir $source_path
+ or die encode_utf8("Cannot change to directory $source_path");
+
+ my $sha1sums_bytes;
+ run3('find . -type f -print0 | sort -z | xargs -0 sha1sum',
+ \undef, \$sha1sums_bytes);
+
+ chdir $savedir
+ or die encode_utf8("Cannot change to directory $savedir");
+
+ my $sha1sums = decode_utf8($sha1sums_bytes);
+
+ my $checksum_path = "$build_path/source-files.sha1sums";
+ if (-r $checksum_path) {
+ my $previous = path($checksum_path)->slurp_utf8;
+
+ # only rebuild if needed
+ # also need to look for build subject
+ return
+ if $sha1sums eq $previous;
+ }
+
+ $0 = "Lintian build test: $recipe [$position/$total]";
+ say encode_utf8('Building in '
+ . path($build_path)->relative->stringify
+ . " [$position/$total]");
+
+ path($build_path)->remove_tree
+ if -e $build_path;
+ path($build_path)->mkpath;
+
+ # read dynamic file names
+ my $runfiles = "$source_path/files";
+ my $files = read_config($runfiles);
+
+ my $error;
+
+ my $log_bytes = capture_merged {
+
+ try {
+ # call runner
+ build_subject($source_path, $build_path);
+
+ } catch {
+ # catch any error
+ $error = $@;
+ }
+ };
+
+ my $log = decode_utf8($log_bytes);
+
+ # delete old runner log
+ my $betterlogpath= $build_path . $SLASH . $files->unfolded_value('Log');
+ if (-e $betterlogpath) {
+ unlink $betterlogpath
+ or die encode_utf8("Cannot unlink $betterlogpath");
+ }
+
+ # move the early log for directory preparation to position of runner log
+ my $earlylogpath = "$source_path.log";
+ move($earlylogpath, $betterlogpath) if -e $earlylogpath;
+
+ # append runner log to population log
+ path($betterlogpath)->append_utf8($log) if length $log;
+
+ # add error if there was one
+ path($betterlogpath)->append_utf8($error) if length $error;
+
+ path($checksum_path)->spew_utf8($sha1sums)
+ unless length $error;
+
+ $mce->gather(path($build_path)->relative->stringify, $error . $log)
+ if length $error;
+
+ return;
+}
+
+sub prepare_test {
+ my ($mce, $specpath) = @_;
+
+ # label process
+ $0 = "Lintian prepare test: $specpath";
+
+ # calculate destination
+ my $relative = path($specpath)->relative("$testset/recipes");
+ my $buildpath = $relative->absolute($buildroot)->stringify;
+ my $evalpath = $relative->absolute($evalroot)->relative->stringify;
+
+ my $error;
+
+ # capture output
+ my $log_bytes = capture_merged {
+
+ try {
+
+ # remove destination
+ path($evalpath)->remove_tree
+ if -e $evalpath;
+
+ path($evalpath)->mkpath;
+
+ # prepare
+ filleval("$specpath/eval", $evalpath, $testset);
+
+ my $traversal = Cwd::realpath("$buildpath/subject");
+
+ if (length $traversal) {
+ die encode_utf8("Cannot link to subject in $buildpath")
+ if system("cd $evalpath; ln -s $traversal subject");
+ }
+
+ }catch {
+ # catch any error
+ $error = $@;
+ }
+ };
+
+ my $log = decode_utf8($log_bytes);
+
+ # save log;
+ my $logfile = "$evalpath/log";
+ path($logfile)->spew_utf8($log) if $log;
+
+ # print something if there was an error
+ die encode_utf8(
+ ($log // $EMPTY) . "Preparation failed for $specpath: $error")
+ if $error;
+
+ return $specpath;
+}
+
+=item default_parallel
+
+=cut
+
+# Return the default number of parallelization to be used
+sub default_parallel {
+ # check cpuinfo for the number of cores...
+ my $cpus = decode_utf8(safe_qx('nproc'));
+ if ($cpus =~ m/^\d+$/) {
+ # Running up to twice the number of cores usually gets the most out
+ # of the CPUs and disks but it might be too aggressive to be the
+ # default for -j. Only use <cores>+1 then.
+ return $cpus + 1;
+ }
+
+ # No decent number of jobs? Just use 2 as a default
+ return 2;
+}
+
+sub usage {
+ my $message =<<"END";
+Usage: $0 [options] [-j [<jobs>]] <testset-directory>
+
+ --onlyrun Select only some tests for a quick check
+ --coverage Run Lintian under Devel::Cover (Warning: painfully slow)
+ -d Display additional debugging information
+ --dump-logs Print build log to STDOUT, if a build fails.
+ -j [<jobs>] Run up to <jobs> jobs in parallel.
+ If -j is passed without specifying <jobs>, the number
+ of jobs started is <nproc>+1.
+ -k Do not stop after one failed test
+ -v Be more verbose
+ --help, -h Print this help and exit
+
+ The option --onlyrun causes runtests to only run tests that match
+ the particular selection. This parameter can be a list of selectors:
+ what:<which>[,<what:...>]
+
+ * test:<testname>
+ - Run the named test. Please note that testnames may not be
+ unique, so it may run more than one test.
+ * script:(<script-name> || <dir-in-scripts-suite>)
+ - Run the named code quality script or all in the named directory.
+ E.g. "01-critic" will run all tests in "t/scripts/01-critic/".
+ * check:<check-name>
+ - Run all tests related to the given check.
+ * suite:<suite>
+ - Run all tests in the named suite.
+ * tag:<tag-name>
+ - Run any test that lists <tag-name> in "Test-For" or
+ "Test-Against".
+
+Test artifacts are cached in --work-dir [default: debian/test-out] and
+will generally be reused to save time. To recreate the test packages,
+run 'private/build-test-packages'.
+END
+
+ print encode_utf8($message);
+
+ return;
+}
+
+sub quick_hint {
+ my ($selection) = @_;
+
+ my $message =<<"END";
+
+No tests were selected by your filter:
+
+ $selection
+
+To select your tests, please use an appropriate argument with a
+selector like:
+
+ 'suite:', 'test:', 'check:', 'tag:', or 'script:'
+
+You can also use 'minimal:', which runs only the tests that cannot
+be turned off, such as the internal tests for the harness.
+END
+
+ print encode_utf8($message);
+
+ return;
+}
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et