tests: add setup.pl, test.pl, let `make check' run qtqa selftests

The qtqa module contains our test scripts used in CI.  It is critical
that these scripts themselves have a complete and regularly executed
test suite, otherwise there is no safety net preventing the pushing of
completely broken test scripts breaking CI for all Qt modules.

  setup.pl: install all needed perl and python modules for the qtqa test
  scripts.  Should be run as the first part of any test procedure which
  uses the qtqa scripts.

  test.pl: run all selftests for the qtqa test scripts.  Called by
  `make check'.

Task: QTQAINFRA-145
Reviewed-by: Sunil Thaha
Reviewed-by: Shane Bradley
Change-Id: I2b7c5cc23ad3ef4b9b0ecb5aabba04a9aa25dfe3

1 files changed, 241 insertions, 0 deletions

diff --git a/scripts/test.pl b/scripts/test.pl
new file mode 100755
index 00000000..993ff38f
--- /dev/null
+++ b/scripts/test.pl
@@ -0,0 +1,241 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+package QtQaTest;
+
+=head1 NAME
+
+test.pl - run autotests for the Qt QA scripts
+
+=head1 SYNOPSIS
+
+  ./test.pl [ --clean ] [ --rerun-tests ]
+
+Run the automated test suite in this repository.
+
+=head2 Options:
+
+=over
+
+=item --clean
+
+Instead of running against the perl and python environment set up
+in the caller's environment, create a new perl and python environment
+in a temporary directory, and delete it after the test completes.
+
+This is the most accurate way to test that all prerequisites are
+correctly specified in setup.pl.  However, it significantly increases
+the test time.
+
+=item --rerun-tests
+
+After running all of the autotests, run again any which have failed.
+This is a simple way to quickly show up any tests which are highly
+unstable, and to make it easier to read the output to see which
+tests have failed.
+
+=back
+
+On a typical clean Linux workstation, this script shouldn't require any
+additional prerequisites other than the perl B<local::lib> dependency
+and the python virtualenv dependency needed by L<setup.pl>.
+
+=cut
+
+use English               qw( -no_match_vars      );
+use File::Path            qw( rmtree              );
+use File::Spec::Functions qw( catfile             );
+use File::Temp            qw( tempdir             );
+use FindBin               qw(                     );
+use Getopt::Long          qw( GetOptionsFromArray );
+use Pod::Usage            qw( pod2usage           );
+
+sub new
+{
+    my ($class, @args) = @_;
+
+    my %self = (
+        'clean'       =>  0,
+        'rerun-tests' =>  0,
+    );
+
+    GetOptionsFromArray(\@args,
+        "clean"         =>  \$self{ 'clean'       },
+        "rerun-tests"   =>  \$self{ 'rerun-tests' },
+        "help"          =>  sub { pod2usage(1) },
+    ) || pod2usage(2);
+
+    bless \%self, $class;
+    return \%self;
+}
+
+sub system_or_die
+{
+    my ($self, @command_with_args) = @_;
+
+    my $command = join(" ", @command_with_args);
+    print "+ $command\n";
+    system(@command_with_args);
+    if ($? == -1) {
+        die "$command failed to execute: $!\n";
+    }
+    elsif ($? & 127) {
+        die(sprintf "$command died with signal %d\n", ($? & 127));
+    }
+    elsif ($?) {
+        die(sprintf "$command exited with value %d\n", $? >> 8);
+    }
+
+    return;
+}
+
+# Use setup.pl to install prereqs
+sub run_setup_pl
+{
+    my $self = shift;
+
+    my $setup = catfile($FindBin::Bin, 'setup.pl');
+    my @cmd = ('perl', $setup, '--install');
+    if ($self->{perldir}) {
+        push @cmd, '--prefix', $self->{perldir};
+    }
+
+    $self->system_or_die(@cmd);
+
+    return;
+}
+
+# Run all of the autotests, using prove.
+sub run_prove
+{
+    my $self = shift;
+
+    # While running the tests, it is good to use a
+    # "temporary temporary directory", because a few things expect to use /tmp
+    # as semi-persistent storage.  Ideally nothing would do this, but some third
+    # party modules may do so.
+    #
+    # We clean up the directory before the test if it exists, but we make no
+    # attempt to clean up this directory after the test:
+    #
+    #  - if running in CI system, the CI system will clean it
+    #  - if running locally, and a test fails, the user might like to look at
+    #    some of the data left behind
+    #
+    my $tmpdir = catfile($FindBin::Bin, 'test_pl_tmp');
+    if (-e $tmpdir) {
+        rmtree($tmpdir, 0, 0) || die "rmtree $tmpdir: $OS_ERROR";
+    }
+    mkdir($tmpdir) || die "mkdir $tmpdir: $OS_ERROR";
+    local $ENV{TMPDIR} = $tmpdir;
+
+    my @prove = (
+        'prove',
+
+        # Use `--merge' because we have some tests which are expected to output a
+        # lot of stderr which look like errors (e.g. test for the Pulse::x handling
+        # of transient errors).  Having these visible by default is rather
+        # confusing to e.g. the CI system, which will extract these "errors" into
+        # report emails.
+        #
+        # If we are re-running the tests later, we won't use `--merge', so failing
+        # tests will still have all the details available.
+        '--merge',
+
+        # Use `--state=save' so, if running manually, the user can easily
+        # re-run only the failed tests if desired; and to support the rerun-tests
+        # option.
+        #
+        '--state=save',
+
+        # Run all tests under the directory in which test.pl is located
+        '--recurse',
+        $FindBin::Bin
+    );
+
+    if (!$self->{'rerun-tests'}) {
+        $self->system_or_die(@prove);
+    }
+    else {
+        eval { $self->system_or_die(@prove) };
+        my $error = $@;
+        if ($error) {
+            print "\n\nI'm going to run only the failed tests again:\n";
+            $self->system_or_die(
+                'prove',
+
+                # This will run only the tests which were marked as failing ...
+                '--state=failed,save',
+
+                # ...and this will be quite verbose, to aid in
+                # figuring out the problem.
+                '--verbose',
+            );
+
+            # The second attempt may have passed, in the case of unstable
+            # tests, but we still should consider this a fatal error.
+            die $error;
+        }
+    }
+
+    return;
+}
+
+sub make_clean_prefix
+{
+    my ($self) = @_;
+
+    my $cleandir = tempdir( 'qt-qa-test-pl.XXXXXX', CLEANUP => 1, TMPDIR => 1 );
+
+    print "Using $cleandir as perl and python prefix.\n";
+
+    # perl: local::lib creates the dirs and sets environment in the current process.
+    # Unsetting PERL5LIB first ensures that this is the only local::lib in the
+    # environment.
+    $ENV{PERL5LIB} = q{};   ## no critic - localized by caller
+    my $perl_dir = "$cleandir/perl";
+    require local::lib;
+    local::lib->import($perl_dir);
+
+    $self->{perldir} = $perl_dir;
+
+    # python: virtualenv creates the dirs.  It does not set env,
+    # so we do it manually.
+    my $virtualenv_dir = "$cleandir/python";
+    $self->system_or_die('virtualenv', '--clear', $virtualenv_dir);
+
+    $ENV{VIRTUAL_ENV} = $virtualenv_dir;                   ## no critic - localized by caller
+    $ENV{PATH}        = "$virtualenv_dir/bin:".$ENV{PATH}; ## no critic - localized by caller
+
+    return;
+}
+
+sub run
+{
+    my ($self) = @_;
+
+    if ($OSNAME =~ m{win32}i) {
+        print "SKIP: sorry, this script does not yet support Windows :(\n";
+        return;
+    }
+
+    # localize in case we modify these in the below block.
+    local $ENV{VIRTUAL_ENV} = $ENV{VIRTUAL_ENV};
+    local $ENV{PATH}        = $ENV{PATH};
+    local $ENV{PERL5LIB}    = $ENV{PERL5LIB};
+
+    if ($self->{clean}) {
+        $self->make_clean_prefix;
+    }
+
+    $self->run_setup_pl;
+    $self->run_prove;
+
+    return;
+}
+
+#==============================================================================
+
+QtQaTest->new(@ARGV)->run if (!caller);
+1;