diff t/harness5 @ 0:c341f82e7ad7 default tip

Rakudo branch in cr.ie.u-ryukyu.ac.jp
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Thu, 26 Dec 2019 16:50:27 +0900
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/t/harness5	Thu Dec 26 16:50:27 2019 +0900
@@ -0,0 +1,276 @@
+#!/usr/bin/env perl
+
+# note: Due to a limitation in Getopt::Long options that should be passed
+# through to fudgeall have to come after all other options
+
+use strict;
+use warnings;
+
+use FindBin;
+use File::Spec;
+use List::Util qw(shuffle);
+use Getopt::Long qw(:config pass_through);
+use Pod::Usage;
+
+use Test::Harness;
+$Test::Harness::switches = '';
+
+use constant FULL_ROAST_TEST_LIST_FILE => 't/spectest.data';
+use constant ROAST_VERSION_FILE        => 't/spec/VERSION';
+my $win   = $^O eq 'MSWin32';
+my $slash = $win ? '\\' : '/';
+
+GetOptions(
+    'tests-from-file=s' => \my $list_file,
+    'fudge'             => \my $do_fudge,
+    'verbosity=i'       => \$Test::Harness::verbose,
+    'jobs:1'            => \(my $jobs = $ENV{TEST_JOBS} || 6),
+    'quick:1'           => \my $do_quick,
+    'stress:1'          => \my $do_stress,
+    'archive=s'         => \my $archive,
+    'precompile'        => \my $precompile,
+    'jvm'               => \my $jvm,
+    'js'               => \my $js,
+    'moar'              => \my $moar,
+    'randomize'         => \my $randomize,
+    'slow'              => \(my $slow = !$win),
+    'no-merge'             => \my $no_merge,
+    'help|h' => sub { pod2usage(1); },
+) or pod2usage(2);
+
+my @pass_through_options = grep m/^--?[^-]/, @ARGV;
+my @files = grep m/^[^-]/, @ARGV;
+
+$ENV{'HARNESS_PERL'} = ".${slash}perl6-" . ($js ? "js" : $moar ? "m" : $jvm ? "j" : "m");
+$ENV{'PERL6LIB'} = "./lib"; 
+
+my @slow;
+if ($list_file) {
+    $list_file = convert_to_versioned_file($list_file);
+
+    my $perl5 = not system $ENV{HARNESS_PERL} . ' -e "exit !try { require Inline::Perl5; 1 }"';
+    if (!$perl5) {
+        print "Inline::Perl5 not installed: not running Perl 5 integration tests\n";
+        print "You can install Inline::Perl5 into the build directory with\n\n";
+        print "    zef --install-to=inst#$FindBin::Bin/../gen/build_rakudo_home/site install Inline::Perl5\n\n";
+    }
+
+    open(my $f, '<', $list_file)
+        or die "Can't open file '$list_file' for reading: $!";
+    while (<$f>) {
+        next if m/^\s*#/;
+        next unless m/\S/;
+        s/^\s+//;
+        s/\s+\z//;
+        my ($fn, $fudgespec) = split /\s+#\s*/;
+        if ($fudgespec) {
+            next if ($fudgespec =~ m/perl5/)  && !$perl5;
+            next if ($fudgespec =~ m/long/)   && $do_quick;
+            next if ($fudgespec =~ m/stress/) && !$do_stress;
+            next if ($fudgespec =~ m/jvm/)    && !$jvm;
+            next if ($fudgespec =~ m/moar/)   && !$moar;
+            next if ($fudgespec =~ m/conc/)   && !($moar || $jvm);
+        }
+
+        $fn = "t/spec/$fn" unless $fn =~ m/^t\Q$slash\Espec\Q$slash\E/;
+        $fn =~ s{/}{$slash}g;
+        if ( -r $fn ) {
+            $slow && $fudgespec && $fudgespec =~ m/slow/
+              ? push @slow, $fn
+              : push @files, $fn;
+        } else {
+            warn "Missing test file: $fn\n";
+        }
+    }
+    close $f or die $!;
+}
+
+my @tfiles = $randomize
+  ? shuffle map { all_in($_) } @files
+  : map { all_in($_) } sort @files;
+
+
+if (@slow) {
+    @slow = map { all_in($_) } @slow;
+
+    if ($jobs > 1) {
+        @tfiles = batch( @tfiles/(@slow + 1), @tfiles );
+        @tfiles = map { (@slow ? shift(@slow) : ()), @$_ } @tfiles;
+    }
+    else {
+        unshift @tfiles, map { all_in($_) } @slow;
+    }
+}
+
+if ($do_fudge) {
+    @tfiles = map { fudge(@$_) } batch( 200, @tfiles );
+}
+
+sub has_use_lib {
+  my ($file) = @_;
+  my $seen_use_lib = 0;
+  open(my $fh, '<', $file);
+  while (my $line = <$fh>) {
+     $seen_use_lib = 1 if $line =~ /^\s*use lib/;
+  }
+  $seen_use_lib;
+}
+
+if ($precompile) {
+  @tfiles = map {
+    if (ref $_) {
+      [grep {!has_use_lib($_)} @$_];
+    } else {
+      has_use_lib($_) ? () : $_;
+    }
+  } @tfiles;
+}
+
+my $tap_harness_class = 'TAP::Harness';
+$tap_harness_class .= '::Archive' if $archive;
+
+my $extra_properties;
+if ($archive) {
+    $extra_properties->{'Submitter'} = $ENV{SMOLDER_SUBMITTER}
+    if $ENV{SMOLDER_SUBMITTER};
+}
+
+if ($jvm) {
+    unlink("TESTTOKEN");
+    $ENV{HARNESS_PERL} = "$^X .${slash}eval-client.pl TESTTOKEN run";
+
+    no warnings 'once';
+    # leak the filehandle; it will be closed at exit, robustly telling the server to terminate
+    open JVMSERVER, "| .${slash}perl6-eval-server -bind-stdin -cookie TESTTOKEN -app .${slash}perl6.jar" or die "cannot fork eval server: $!\n";
+    sleep 1;
+}
+
+if (eval "require $tap_harness_class;") {
+    my $run_with_perl = $precompile ? [$ENV{HARNESS_PERL}, 't/precompileandrun'] : [$ENV{HARNESS_PERL}];
+    my %harness_options = (
+        exec        => $jvm ? [$^X, "./eval-client.pl", "TESTTOKEN", "run"] : $run_with_perl,
+        verbosity   => 0+$Test::Harness::verbose,
+        jobs        => $jobs,
+        ignore_exit => 1,
+        merge       => ($no_merge ? 0 : 1),
+        $TAP::Harness::VERSION gt 3.21 ? (trap => 1) : (),
+        $archive ? ( archive => $archive ) : (),
+        $extra_properties ? ( extra_properties => $extra_properties ) : (),
+    );
+    my $results = $tap_harness_class->new( \%harness_options )->runtests(@tfiles);
+    exit 1 if $results->has_errors;
+}
+elsif ($archive) {
+    die "Can't load $tap_harness_class, which is needed for smolder submissions: $@";
+}
+else {
+    runtests(@tfiles);
+}
+
+sub batch {
+    my $size = shift;
+    my @batches;
+    while (@_) {
+        my @batch = splice @_, 0, $size;
+        push @batches, \@batch;
+    }
+    @batches
+}
+
+# adapted to return only files ending in '.t'
+sub all_in {
+    my $start = shift;
+
+    return $start unless -d $start;
+
+    my @skip = ( File::Spec->updir, File::Spec->curdir, qw( .svn CVS .git ) );
+    my %skip = map {($_,1)} @skip;
+
+    my @hits = ();
+
+    if ( opendir( my $dh, $start ) ) {
+        my @files = sort readdir $dh;
+        closedir $dh or die $!;
+        for my $file ( @files ) {
+            next if $skip{$file};
+
+            my $currfile = File::Spec->catfile( $start, $file );
+            if ( -d $currfile ) {
+                push( @hits, all_in( $currfile ) );
+            } else {
+                push( @hits, $currfile ) if $currfile =~ /\.t$/;
+            }
+        }
+    } else {
+        warn "$start: $!\n";
+    }
+
+    return @hits;
+}
+
+sub fudge {
+    my $impl = $js ? 'rakudo.js' : $moar ? 'rakudo.moar' : 'rakudo.jvm';
+    my $cmd  = join ' ', $^X, 't/spec/fudgeall',
+                         @pass_through_options, $impl, @_;
+    return split ' ', `$cmd`;
+}
+
+sub warn_in_box {
+    warn +('#' x 76) . "\n\n" . shift . "\n\n" . ('#' x 76) . "\n";
+}
+
+sub convert_to_versioned_file {
+    my $file = shift;
+    return $file unless $file eq FULL_ROAST_TEST_LIST_FILE;
+
+    open my $fh, '<', ROAST_VERSION_FILE or do {
+        warn_in_box "Failed to open roast VERSION file in "
+            . ROAST_VERSION_FILE . ": $!\n"
+            . "Defaulting to test files from $file";
+        return $file;
+    };
+    (my $ver = (grep !/^\s*#/ && /\S/, <$fh>)[0]) =~ s/^\s+|\s+$//g;
+
+    # Make a new test file name using the version of the roast. The master
+    # branch would have version something like `6.d-proposals`; in such
+    # a case, we'll use the default test file list
+    my $new_file = $ver =~ /propos/i ? $file : "$file.$ver";
+    if (-r $new_file) {
+        print "Testing Roast version $ver using test file list from $new_file\n";
+        return $new_file;
+    }
+
+    warn_in_box "Test list file `$new_file` for Roast version $ver does not exist\n"
+        . "or isn't readable. Defaulting to $file";
+    return $file;
+}
+
+=head1 NAME
+
+t/harness - run the harness tests for Rakudo.
+
+=head1 SYNOPSIS
+
+t/harness [options] [files]
+
+Options:
+
+    --help / -h - display the help message.
+    --tests-from-file=[filename] - get the tests from the filename.
+    --fudge - fudge (?)
+    --jobs - number of jobs. Defaults to TEST_JOBS env var if specified, or 1
+    --quick - do not run tests marked as long-running
+    --stress - run tests marked as stress tests
+    --archive=[archive] - write to an archive.
+    --randomize randomize the order in which test-files are processed.
+    --slow - spread tests marked "slow" equally over the run (default on non-Win)
+    --moar/--jvm/--js - mutually exclusive. Use MoarVM/JVM backend
+    --no-merge - pass STDERR from the tests through to the terminal's STDERR
+    --precompile - precompile tests before running them
+
+    --verbosity=[level] - set the verbosity level.
+       1   verbose        Print individual test results to STDOUT.
+       0   normal
+      -1   quiet  Suppress some test output. Mostly failures when tests running.
+      -2   really quiet   Suppress everything but the tests summary.
+      -3   silent         Suppress everything.