#!perl
use strict;
use warnings;
use TAP::Harness ();
use IO::Scalar;
use Test::More;
#my @optimizations = ( '-O2,-fno-fold', '-O1' );
my @optimizations = $ENV{BC_OPT} ? split(/\s+/,$ENV{BC_OPT}) : ('-O0','-O3');
my $todo = '';
# Setup file_to_test to be the file we actually want to test.
my $file_to_test = $0;
if ( $file_to_test =~ s{==(.*)\.t$}{.t} ) {
my $options = $1;
$todo = "B::C Fails to generate c code. Issues: $1" if ( $options =~ /BC-([\d-]+)/ );
$todo = "gcc cannot compile generated c code. Issues: $1" if ( $options =~ /GCC-([\d-]+)/ );
$todo = "Compiled binary exits with signal. Issues: $1" if ( $options =~ /SIG-([\d-]+)/ );
$todo = "Test crashes before completion. Issues: $1" if ( $options =~ /BADPLAN-([\d-]+)/ );
$todo = "Fails tests when compiled with perlcc. Issues: $1" if ( $options =~ /BADTEST-([\d-]+)/ );
$todo = "Tests out of sequence. Issues: $1" if ( $options =~ /SEQ-([\d-]+)/ );
$todo = "TODO test unexpectedly passing. Issues: $1" if ( $options =~ /TODO-([\d-]+)/ );
}
$file_to_test =~ s{--}{/}g;
$file_to_test =~ s{C-COMPILED/}{}; # Strip the BINARY dir off to look for this test elsewhere.
if ( $] < 5.014 && $file_to_test =~ m{^t/CORE/} ) {
plan skip_all => "Perl CORE tests only supported since 5.14 right now.";
}
else {
plan tests => 3 + 10 * scalar @optimizations;
}
ok( !-z $file_to_test, "$file_to_test exists" );
open( my $fh, '<', $file_to_test ) or die("Can't open $file_to_test");
my $taint = <$fh>;
close $fh;
$taint = ( ( $taint =~ m/\s\-T/ ) ? '-T' : '' );
pass( $taint ? "Taint mode!" : "Not in taint mode" );
( my $c_file = $file_to_test ) =~ s/\.t$/.c/;
( my $bin_file = $file_to_test ) =~ s/\.t$/.bin/;
unlink $bin_file, $c_file;
my $PERL = $^X =~ m/\s/ ? qq{"$^X"} : $^X;
my $check = `$PERL -c $taint '$file_to_test' 2>&1`;
like( $check, qr/syntax OK/, "$PERL -c $taint $file_to_test" );
$ENV{HARNESS_NOTTY} = 1;
my %SIGNALS = qw( 11 SEGV 6 SIGABRT 1 SIGHUP 13 SIGPIPE);
$SIGNALS{0} = '';
foreach my $optimization (@optimizations) {
TODO: {
SKIP: {
local $TODO = $todo if ( $todo =~ /B::C Fails to generate c code/ );
local $ENV{BC_OPT} = $optimization;
my $b = $optimization; # protect against parallel test name clashes
#$b =~ s/-(D.*|f.*|v),//g;
#$b =~ s/-/_/g;
#$b =~ s/[, ]//g;
#$b =~ s/_O0$//;
#$b = lc($b);
$b = ''; # need to check $0 diagnostics
( $c_file = $file_to_test ) =~ s/\.t$/$b.c/;
$b = '.bin'; # need to check $0 diagnostics
( $bin_file = $file_to_test ) =~ s/\.t$/$b/;
unlink $bin_file, $c_file;
# Generate the C code at $optimization level
my $cmd = "$PERL $taint -Iblib/arch -Iblib/lib -MO=-qq,C,$optimization,-o$c_file $file_to_test 2>&1";
diag $cmd if $ENV{TEST_VERBOSE};
my $BC_output = `$cmd`;
note $BC_output if ($BC_output);
ok( !-z $c_file, "$c_file is generated ($optimization)" );
if ( -z $c_file ) {
unlink $c_file;
skip( "Can't test further due to failure to create a c file.", 9 );
}
# gcc the c code.
local $TODO = $todo if ( $todo =~ /gcc cannot compile generated c code/ );
$cmd = "$PERL -Iblib/arch -Iblib/lib script/cc_harness -q $c_file -o $bin_file 2>&1";
diag $cmd if $ENV{TEST_VERBOSE};
my $compile_output = `$cmd`;
note $compile_output if $compile_output;
# Validate compiles
ok( -x $bin_file, "$bin_file is compiled and ready to run." );
if ( !-x $bin_file ) {
unlink $c_file, $bin_file unless $ENV{BC_DEVELOPING};
skip( "Can't test further due to failure to create a binary file.", 8 );
}
# Parse through TAP::Harness
my $out = '';
my $out_fh = new IO::Scalar \$out;
my %args = (
verbosity => 1,
lib => [],
merge => 1,
stdout => $out_fh,
);
my $harness = TAP::Harness->new( \%args );
my $res = $harness->runtests($bin_file);
close $out_fh;
my $parser = $res->{parser_for}->{$bin_file};
ok( $parser, "Output parsed by TAP::Harness" );
my $signal = $res->{wait} % 256;
if ( $todo =~ /Compiled binary exits with signal/ ) {
local $TODO = "Tests don't pass at the moment - $todo";
my $sig_name = $SIGNALS{$signal};
ok( $signal == 0, "Exit signal is $signal ($sig_name)" );
note $out if ($out);
skip( "Test failures irrelevant if exits premature with $sig_name", 6 );
}
else {
ok( $signal == 0, "Exit signal is $signal" );
}
if ( $todo =~ m/Test crashes before completion/ ) {
local $TODO = $todo;
ok( $parser->{is_good_plan}, "Plan was valid" );
note $out;
skip( "TAP parse is unpredictable when plan is invalid", 5 );
}
else {
ok( $parser->{is_good_plan}, "Plan was valid" );
}
ok( $parser->{exit} == 0, "Exit code is $parser->{exit}" );
local $TODO = "Tests don't pass at the moment - $todo"
if ( $todo =~ /Fails tests when compiled with perlcc/ );
ok( !scalar @{ $parser->{failed} }, "Test results:" );
print " $_\n" foreach ( split( "\n", $out ) );
if (!ok( !scalar @{ $parser->{failed} }, "No test failures $optimization" )) {
note( "Failed $optimization tests: " . join( ", ", @{ $parser->{failed} } ) );
$ENV{BC_DEVELOPING} = 1; # keep temp files
}
skip( "Don't care about test sequence if tests are failing", 2 )
if ( $todo =~ /Fails tests when compiled with perlcc/ );
local $TODO = $todo if ( $todo =~ m/Tests out of sequence/ );
if (!ok( !scalar @{ $parser->{parse_errors} }, "Tests are in sequence" )) {
note explain $parser->{parse_errors};
$ENV{BC_DEVELOPING} = 1; # keep temp files
}
local $TODO = "tests unexpectedly passing" if scalar @{ $parser->{todo_passed} };
if (!ok( !scalar @{ $parser->{todo_passed} }, "No TODO tests passed $optimization" )) {
note( "TODO Passed: " . join( ", ", @{ $parser->{todo_passed} } ) );
$ENV{BC_DEVELOPING} = 1; # keep temp files
}
$TODO = '';
}
}
unlink $bin_file, $c_file unless $ENV{BC_DEVELOPING};
}