Mercurial > hg > Others > Rakudo
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.