Others/Rakudo: t/harness5 comparison

comparison 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

comparison

equal deleted inserted replaced

--1:000000000000
+:c341f82e7ad7
+#!/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.

Mercurial > hg > Others > Rakudo

comparison t/harness5 @ 0:c341f82e7ad7 default tip