diff --git a/tools/autounfudge.pl b/tools/autounfudge.pl index 08117b15bd4..c4c01863f26 100755 --- a/tools/autounfudge.pl +++ b/tools/autounfudge.pl @@ -88,13 +88,15 @@ =head1 MISCELLANEA my $path_sep = $^O eq 'MSWin32' ? ';' : ':'; my $slash = $^O eq 'MSWin32' ? '\\' : '/'; -$ENV{PERL6LIB} = join($path_sep, qw/lib ./) unless $keep_env; +$ENV{RAKULIB} = join($path_sep, qw/lib ./) unless $keep_env; my $impl_re = quotemeta $impl; +my $impl_bin; if ($impl eq 'rakudo') { my $postfix = $jvm ? 'jvm' : 'moar' ; $impl_re = qr{rakudo(?:\.$postfix)?(?=\s)}; + $impl_bin = File::Spec->catdir('.', $jvm ? 'rakudo-j' : 'rakudo-m'); } my %fh; @@ -241,7 +243,7 @@ sub usage { --impl impl Specify a different implementation --specfile file Specification file to read filenames from --auto use t/spec/spectest.data for --specfile - --keep-env Keep RAKUDOLIB environment variable. + --keep-env Keep RAKULIB environment variable. --exclude regex Don't run the tests that match regex --section number Run only on tests belonging to section --unskip Try to change 'skip' to 'todo' markers @@ -296,7 +298,7 @@ sub get_harness { my $token = shift; return TAP::Harness->new({ verbosity => -2, - exec => $jvm ? [$^X, "./eval-client.pl", $token, "run"] : [$^X, 'tools/rakudo-limited.pl'], + exec => $jvm ? [$^X, "./eval-client.pl", $token, "run"] : [$^X, 'tools/rakudo-limited.pl', $impl_bin], merge => 1, }); } diff --git a/tools/rakudo-limited.pl b/tools/rakudo-limited.pl index c14f5c37652..e22a102f35b 100755 --- a/tools/rakudo-limited.pl +++ b/tools/rakudo-limited.pl @@ -1,3 +1,3 @@ #!/usr/bin/env perl -exec "ulimit -t 45; ulimit -v 2048576; ./inst-rakudo @ARGV"; +exec "ulimit -t 45; ulimit -v 2048576; @ARGV"; diff --git a/tools/update-passing-test-data.pl b/tools/update-passing-test-data.pl index 1ae6911bbd3..554f4d53b19 100755 --- a/tools/update-passing-test-data.pl +++ b/tools/update-passing-test-data.pl @@ -18,29 +18,53 @@ =head1 DESCRIPTION =cut +use v5.10; use strict; use warnings; +use Getopt::Long; +use FindBin; +use File::Spec; use TAP::Harness; use TAP::Parser::Aggregator 3.01; use File::Find; +my $istty = -t STDOUT; +my %options; +my $base_dir = File::Spec->rel2abs( File::Spec->catdir( $FindBin::Bin, '..' ) ); +my $spec_dir = File::Spec->catdir( $base_dir, 't', 'spec' ); +my %backend_bin = ( + moar => 'rakudo-m', + jvm => 'rakudo-j', + js => 'rakudo-js', +); + +GetOptions( \%options, 'help!', 'backend=s@', ); + +$options{backend} = [ + map { die "Unknwon backend '$_'" unless exists $backend_bin{$_}; $_ } + split( /,/, join( ",", @{ $options{backend} // [qw] } ) ) +]; + my %not_process = map { $_ => 1 } read_specfile('t/spec/spectest.data'); + # this is a p5 file, don't try to test it. -$not_process{'t/spec/t/fudge.t'}=1; +$not_process{'t/spec/t/fudge.t'} = 1; print <<'KEY'; -Key: -[S ] = some tests passed -[ P ] = plan ok (ran all tests) -[ A] = all passed - ( passed / planned or ran ) -================================== +A backend column: + ... passed/planned-or-ran +where the '...' are flags: + S.. = some tests passed + .P. = plan ok (ran all tests) + ..A = all passed KEY my @wanted; +my %short_path; +my $max_path_len = 32; -find({ wanted => \&queue, no_chdir => 1 }, 't/spec/'); +find( { wanted => \&queue, no_chdir => 1 }, 't/spec/' ); sub queue { return if -d $_; @@ -49,24 +73,36 @@ sub queue { return if $not_process{$_}; push @wanted, $_; + my $splen = length( + $short_path{$_} = File::Spec->abs2rel( + File::Spec->rel2abs( $_, $base_dir ), $spec_dir + ) + ); + $max_path_len = $splen if $splen > $max_path_len; } -if ( ! defined $ENV{TEST_JOBS} || int $ENV{TEST_JOBS} <= 1 ) { - go( $_ ) for @wanted; +my $sep_line = ( '+' . '-' x 17 ) x scalar( @{ $options{backend} } ) . '+' + . ( '-' x ( $max_path_len + 2 ) ) . '+'; +say "$sep_line\n", ( map { sprintf '| %-15s ', $_ } @{ $options{backend} } ), + sprintf( "| %-${max_path_len}s |", "" ), "\n$sep_line"; + +if ( !defined $ENV{TEST_JOBS} || int $ENV{TEST_JOBS} <= 1 ) { + go($_) for @wanted; } else { my $jobs_wanted = int $ENV{TEST_JOBS}; my %running; - while( @wanted || %running ) { + while ( @wanted || %running ) { + print STDERR scalar(%running), " working, ", scalar(@wanted), " remain\r" if $istty; if ( @wanted && $jobs_wanted > keys %running ) { my $file = shift @wanted; - my $pid = fork; - if ( $pid ) { # parent - $running{ $pid } = $file; + my $pid = fork; + if ($pid) { # parent + $running{$pid} = $file; } - elsif ( defined $pid ) { # child - go( $file ); + elsif ( defined $pid ) { # child + go($file); exit; } else { @@ -75,46 +111,60 @@ sub queue { } else { my $pid = wait; - if ( ! defined delete $running{ $pid } ) { + if ( !defined delete $running{$pid} ) { die "reaped unknown child PID '$pid'"; } } } } +say $sep_line; + sub go { my $orig = shift @_; - my $fudged = qx{t/spec/fudge --keep-exit-code rakudo $orig}; - chomp $fudged; - - my $H = get_harness(); - my $agg = TAP::Parser::Aggregator->new(); - $agg->start(); - $H->aggregate_tests($agg, $fudged); - $agg->stop(); - - # "older" version (prior to 3.16, which isn't released at the time - # of writing) don't have a planned() method, so fall back on - # total() instead - my $planned = eval { $agg->cplanned }; - $planned = $agg->total unless defined $planned; - - my ($some_passed, $plan_ok, $all_passed) = (' ', ' ', ' '); - my $actually_passed = $agg->passed - $agg->skipped - $agg->todo; - $some_passed = 'S' if $actually_passed; - $plan_ok = 'P' if !scalar($agg->parse_errors); - $all_passed = 'A' if ! $agg->has_errors; - printf "[%s%s%s] (% 3d/%-3d) %s\n", $some_passed, $plan_ok, $all_passed, - $actually_passed, $planned, $orig + my $short_path = + File::Spec->abs2rel( File::Spec->rel2abs( $orig, $base_dir ), $spec_dir ); + + my %status; + + foreach my $backend ( @{ $options{backend} } ) { + my $fudged = qx{t/spec/fudge --keep-exit-code rakudo.$backend $orig}; + chomp $fudged; + + my $compiler_bin = + File::Spec->catdir( $base_dir, $backend_bin{$backend} ); + my $H = get_harness($compiler_bin); + my $agg = TAP::Parser::Aggregator->new(); + $agg->start(); + $H->aggregate_tests( $agg, $fudged ); + $agg->stop(); + + # "older" version (prior to 3.16, which isn't released at the time + # of writing) don't have a planned() method, so fall back on + # total() instead + my $planned = eval { $agg->cplanned } // $agg->total; + + my ( $some_passed, $plan_ok, $all_passed ) = ('.') x 3; + my $actually_passed = $agg->passed - $agg->skipped - $agg->todo; + $some_passed = 'S' if $actually_passed; + $plan_ok = 'P' if !scalar( $agg->parse_errors ); + $all_passed = 'A' if !$agg->has_errors; + $status{$backend}{out} = sprintf( "%s%s%s %5d/%-5d", + $some_passed, $plan_ok, $all_passed, $actually_passed, $planned ); + } + + say "| ", + join( " | ", map { $status{$_}{out} } @{ $options{backend} } ), + " | ", sprintf( "%-${max_path_len}s |", $short_path{$orig} ); } sub read_specfile { my $fn = shift; my @res; - open (my $f, '<', $fn) or die "Can't open file '$fn' for reading: $!"; - while (<$f>){ - s/\s*\#.*//; # strip out comments and any spaces before them + open( my $f, '<', $fn ) or die "Can't open file '$fn' for reading: $!"; + while (<$f>) { + s/\s*\#.*//; # strip out comments and any spaces before them m/(\S+)/ && push @res, "t/spec/$1"; } close $f or die $!; @@ -122,11 +172,18 @@ sub read_specfile { } sub get_harness { - return TAP::Harness->new({ - verbosity => -2, - exec => [$^X, 'tools/rakudo-limited.pl', qw/-Ilib -I./], - merge => 1, - }); + my $rakudo_bin = shift; + return TAP::Harness->new( + { + verbosity => -2, + exec => [ $rakudo_bin, qw/-Ilib -I./ ], + + # Not sure if limiting is required as this script is not + # targetting any kind of automation. + #[ $^X, 'tools/rakudo-limited.pl', $rakudo_bin, qw/-Ilib -I./ ], + merge => 1, + } + ); } # Local Variables: