Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
209 lines (172 sloc) 5.86 KB
#! 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 = '';
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,
'long:1' => \my $do_long,
'stress:1' => \my $do_stress,
'archive=s' => \my $archive,
'jvm' => \my $jvm,
'moar' => \my $moar,
'randomize' => \my $randomize,
'slow' => \(my $slow = !$win),
'help|h' => sub { pod2usage(1); },
) or pod2usage(2);
$do_long = 1 unless defined $do_long;
$do_stress = 0 unless defined $do_stress;
$jobs = $jobs || $ENV{TEST_JOBS} || 1;
my @pass_through_options = grep m/^--?[^-]/, @ARGV;
my @files = grep m/^[^-]/, @ARGV;
$ENV{'HARNESS_PERL'} = ".${slash}perl6-" . ($moar ? "m" : $jvm ? "j" : "m");
$ENV{'PERL6LIB'} = join ',', qw/ lib . /;
my @slow;
if ($list_file) {
my $perl5 = not system $ENV{HARNESS_PERL} . ' -e "exit !try { require Inline::Perl5; 1 }"';
print "Inline::Perl5 not installed: not running Perl 5 integration tests\n"
if !$perl5;
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_long;
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 );
}
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 %harness_options = (
exec => $jvm ? [$^X, "./eval-client.pl", "TESTTOKEN", "run"] : [$ENV{HARNESS_PERL}],
verbosity => 0+$Test::Harness::verbose,
jobs => $jobs,
ignore_exit => 1,
merge => 1,
$TAP::Harness::VERSION > 3.21 ? (trap => 1) : (),
$archive ? ( archive => $archive ) : (),
$extra_properties ? ( extra_properties => $extra_properties ) : (),
);
$tap_harness_class->new( \%harness_options )->runtests(@tfiles);
}
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 = $jvm ? 'rakudo.jvm' : ($moar ? 'rakudo.moar' : 'rakudo.moar');
my $cmd = join ' ', $^X, 't/spec/fudgeall',
@pass_through_options, $impl, @_;
return split ' ', `$cmd`;
}
=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 (?)
--verbosity=[level] - set the verbosity level.
--jobs - number of jobs.
--long - do long.
--stress - perform the 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 (on non-Win)
Jump to Line
Something went wrong with that request. Please try again.