Adding upstream version 2.117.0.upstream/2.117.0upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

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