Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Rework tools/update-passing-test-data.pl to support backends #3829

Merged
merged 1 commit into from Jul 30, 2020
Merged

Rework tools/update-passing-test-data.pl to support backends #3829

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
8 changes: 5 additions & 3 deletions tools/autounfudge.pl
View file
Open in desktop
Expand Up @@ -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;
Expand Down Expand Up @@ -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 <number>
--unskip Try to change 'skip' to 'todo' markers
Expand Down Expand Up @@ -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,
});
}
Expand Down
2 changes: 1 addition & 1 deletion tools/rakudo-limited.pl
View file
Open in desktop
@@ -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";
151 changes: 104 additions & 47 deletions tools/update-passing-test-data.pl
View file
Open in desktop
Expand Up @@ -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<moar>] } ) )
];

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 $_;
Expand All @@ -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 {
Expand All @@ -75,58 +111,79 @@ 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 $!;
return @res;
}

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:
Expand Down