Adding upstream version 2.117.0.upstream/2.117.0upstream

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

1 files changed, 163 insertions, 0 deletions

diff --git a/lib/Test/Lintian/Build.pm b/lib/Test/Lintian/Build.pm
new file mode 100644
index 0000000..b6819af
--- /dev/null
+++ b/lib/Test/Lintian/Build.pm
@@ -0,0 +1,163 @@
+# Copyright (C) 2018 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
+
+package Test::Lintian::Build;
+
+=head1 NAME
+
+Test::Lintian::Build -- routines to prepare the work directories
+
+=head1 SYNOPSIS
+
+  use Test::Lintian::Build qw(build_subject);
+
+=head1 DESCRIPTION
+
+The routines in this module prepare the work directories in which the
+tests are run. To do so, they use the specifications in the test set.
+
+=cut
+
+use v5.20;
+use warnings;
+use utf8;
+
+use Exporter qw(import);
+
+BEGIN {
+    our @EXPORT_OK = qw(
+      build_subject
+    );
+}
+
+use Carp;
+use Const::Fast;
+use Cwd;
+use IPC::Run3;
+use List::SomeUtils qw(any);
+use Path::Tiny;
+use Unicode::UTF8 qw(valid_utf8 encode_utf8);
+
+use Lintian::Util qw(utf8_clean_log);
+
+use Test::Lintian::ConfigFile qw(read_config);
+use Test::Lintian::Hooks qw(find_missing_prerequisites);
+
+const my $SLASH => q{/};
+const my $WAIT_STATUS_SHIFT => 8;
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item build_subject(PATH)
+
+Populates a work directory RUN_PATH with data from the test located
+in SPEC_PATH. The optional parameter REBUILD forces a rebuild if true.
+
+=cut
+
+sub build_subject {
+    my ($sourcepath, $buildpath) = @_;
+
+    # check test architectures
+    die encode_utf8('DEB_HOST_ARCH is not set.')
+      unless (length $ENV{'DEB_HOST_ARCH'});
+
+    # read dynamic file names
+    my $runfiles = "$sourcepath/files";
+    my $files = read_config($runfiles);
+
+    # read dynamic case data
+    my $rundescpath
+      = $sourcepath . $SLASH . $files->unfolded_value('Fill-Values');
+    my $testcase = read_config($rundescpath);
+
+    # skip test if marked
+    my $skipfile = "$sourcepath/skip";
+    if (-e $skipfile) {
+        my $reason = path($skipfile)->slurp_utf8 || 'No reason given';
+        say encode_utf8("Skipping test: $reason");
+        return;
+    }
+
+    # skip if missing prerequisites
+    my $missing = find_missing_prerequisites($testcase);
+    if (length $missing) {
+        say encode_utf8("Missing prerequisites: $missing");
+        return;
+    }
+
+    path($buildpath)->remove_tree
+      if -e $buildpath;
+
+    path($buildpath)->mkpath;
+
+    # get lintian subject
+    croak encode_utf8('Could not get subject of Lintian examination.')
+      unless $testcase->declares('Build-Product');
+
+    my $build_product = $testcase->unfolded_value('Build-Product');
+    my $subject = "$buildpath/$build_product";
+
+    say encode_utf8("Building in $buildpath");
+
+    my $command = $testcase->unfolded_value('Build-Command');
+    if (length $command) {
+
+        my $savedir = Cwd::getcwd;
+        chdir($buildpath)
+          or die encode_utf8("Cannot change to directory $buildpath");
+
+        my $combined_bytes;
+
+        # array command breaks test files/contents/contains-build-path
+        run3($command, \undef, \$combined_bytes, \$combined_bytes);
+        my $status = ($? >> $WAIT_STATUS_SHIFT);
+
+        chdir($savedir)
+          or die encode_utf8("Cannot change to directory $savedir");
+
+        # sanitize log so it is UTF-8 from here on
+        my $utf8_bytes = utf8_clean_log($combined_bytes);
+        print $utf8_bytes;
+
+        croak encode_utf8("$command failed")
+          if $status;
+    }
+
+    croak encode_utf8('Build was unsuccessful.')
+      unless -e $subject;
+
+    die encode_utf8("Cannot link to build product $build_product")
+      if system("cd $buildpath; ln -s $build_product subject");
+
+    return;
+}
+
+=back
+
+=cut
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 sr et