Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

170 lines (161 sloc) 6.184 kb
#! /usr/bin/env perl
my $keep_pl = 0; # set it to keep the src pl files
my $keep_plc = 0; # set it to keep the bytecode files
my $keep_plc_fail = 1; # set it to keep the bytecode files on failures
my $do_coverage = $ENV{TEST_COVERAGE}; # do bytecode insn coverage
my $verbose = $ENV{TEST_VERBOSE}; # better use t/testplc.sh for debugging
use Config;
# Debugging Note: perl5.6.2 has no -Dvl, use -D260 (256+4) instead. v mapped to f
BEGIN {
if ($^O eq 'VMS') {
print "1..0 # skip - Bytecode/ByteLoader doesn't work on VMS\n";
exit 0;
}
if ($ENV{PERL_CORE}){
chdir('t') if -d 't';
@INC = ('.', '../lib');
} else {
unshift @INC, 't';
push @INC, "blib/arch", "blib/lib";
}
if (($Config{'extensions'} !~ /\bB\b/) ){
print "1..0 # Skip -- Perl configured without B module\n";
exit 0;
}
#if ($Config{ccflags} =~ /-DPERL_COPY_ON_WRITE/) {
# print "1..0 # skip - no COW for now\n";
# exit 0;
#}
require 'test.pl'; # for run_perl()
}
use strict;
my $PERL56 = ( $] < 5.008001 );
my $DEBUGGING = ($Config{ccflags} =~ m/-DDEBUGGING/);
my $ITHREADS = $Config{useithreads};
my $MULTI = $Config{usemultiplicity};
my $AUTHOR = -d '.svn' or -d '.git';
my @tests = tests();
my $numtests = $#tests+1;
$numtests++ if $DEBUGGING and $do_coverage;
print "1..$numtests\n";
my $cnt = 1;
my $test;
my %insncov; # insn coverage
if ($DEBUGGING) {
# op coverage either via Assembler debug, or via ByteLoader -Dv on a -DDEBUGGING perl
if ($do_coverage) {
use B::Asmdata q(@insn_name);
$insncov{$_} = 0 for 0..@insn_name;
}
}
my @todo = (); # 33 fixed with r802, 44 <5.10 fixed later, 27 fixed with r989
@todo = (3,6,8..10,12,15,16,18,26..28,31,33,35,38,41..43,46,50)
if $] < 5.007; # CORE failures, our Bytecode 56 compiler not yet backported
#44 fixed by moving push_begin upfront
push @todo, (21,24..26,28,33,38..39) if $^O eq 'solaris' and $] eq '5.008008';
# fixed with 1.35
#push @todo, (10,18,22,24,27..28,30,45) if $^O eq 'linux' and $] eq '5.008008';
push @todo, (43) if $] >= 5.008004 and $] < 5.008008;
push @todo, (7) if $] >= 5.008004 and $] < 5.008008 and $ITHREADS;
push @todo, (27,42,43) if $] >= 5.010 and $] < 5.013008;
push @todo, (32) if $] > 5.011 and $] < 5.013008; # 2x del_backref fixed with r790
#push @todo, (48) if $] > 5.013; # END block del_backref fixed with r1004
#push @todo, (41) if !$ITHREADS;
# cannot store labels on windows 5.12: 21
push @todo, (21) if $^O =~ /MSWin32|cygwin|AIX/ and $] > 5.011003 and $] < 5.013;
push @todo, (46) if $] >= 5.012;
push @todo, (27) if $] >= 5.014;
push @todo, (42..43) if $] >= 5.010; #freebsd or 64bit centos6
my @skip = ();
#push @skip, (27,32,42..43) if !$ITHREADS;
my %todo = map { $_ => 1 } @todo;
my %skip = map { $_ => 1 } @skip;
my $Mblib = $] >= 5.008 ? "-Mblib" : ""; # test also the CORE B in older perls?
my $backend = "Bytecode";
unless ($Mblib) { # check for -Mblib from the testsuite
if (grep { m{blib(/|\\)arch$} } @INC) {
$Mblib = "-Iblib/arch -Iblib/lib"; # force -Mblib via cmdline, but silent!
}
}
else {
$backend = "-qq,Bytecode" unless $ENV{TEST_VERBOSE};
}
# $backend .= ",-fno-fold,-fno-warnings" if $] >= 5.013005;
$backend .= ",-H" unless $PERL56;
#$Bytecode = $] >= 5.007 ? 'Bytecode' : 'Bytecode56';
#$Mblib = '' if $] < 5.007; # override harness on 5.6. No Bytecode for 5.6 for now.
for (@tests) {
my $todo = $todo{$cnt} ? "#TODO " : "#";
my ($got, @insn);
if ($todo{$cnt} and $skip{$cnt} and !$AUTHOR) {
print sprintf("ok %d # skip\n", $cnt);
next;
}
my ($script, $expect) = split />>>+\n/;
$expect =~ s/\n$//;
$test = "bytecode$cnt.pl";
open T, ">$test"; print T $script; close T;
unlink "${test}c" if -e "${test}c";
$? = 0;
$got = run_perl(switches => [ "$Mblib -MO=$backend,-o${test}c" ],
verbose => $verbose, # for DEBUGGING
nolib => $ENV{PERL_CORE} ? 0 : 1, # include ../lib only in CORE
stderr => $PERL56 ? 1 : 0, # capture "bytecode.pl syntax ok"
timeout => 10,
progfile => $test);
unless ($?) {
# test coverage if -Dv is allowed
if ($do_coverage and $DEBUGGING) {
my $cov = run_perl(progfile => "${test}c", # run the .plc
nolib => $ENV{PERL_CORE} ? 0 : 1,
stderr => 1,
timeout => 20,
switches => [ "$Mblib -Dv".($PERL56 ? " -MByteLoader" : "") ]);
for (map { /\(insn (\d+)\)/ ? $1 : undef }
grep /\(insn (\d+)\)/, split(/\n/, $cov)) {
$insncov{$_}++;
}
}
$? = 0;
$got = run_perl(progfile => "${test}c", # run the .plc
verbose => $ENV{TEST_VERBOSE}, # for debugging
nolib => $ENV{PERL_CORE} ? 0 : 1,
stderr => $PERL56 ? 1 : 0,
timeout => 5,
switches => [ "$Mblib".($PERL56 ? " -MByteLoader" : "") ]);
unless ($?) {
if ($got =~ /^$expect$/) {
print "ok $cnt", $todo eq '#' ? "\n" : "$todo\n";
next;
} else {
# test failed, double check uncompiled
$got = run_perl(verbose => $ENV{TEST_VERBOSE}, # for debugging
nolib => $ENV{PERL_CORE} ? 0 : 1, # include ../lib only in CORE
stderr => 1, # to capture the "ccode.pl syntax ok"
timeout => 5,
progfile => $test);
if (! $? and $got =~ /^$expect$/) {
$keep_plc = $keep_plc_fail unless $keep_plc;
print "not ok $cnt $todo wanted: $expect, got: $got\n";
next;
} else {
print "ok $cnt # skip also fails uncompiled\n";
next;
}
}
}
}
print "not ok $cnt $todo wanted: $expect, \$\? = $?, got: $got\n";
} continue {
1 while unlink($keep_pl ? () : $test, $keep_plc ? () : "${test}c");
$cnt++;
}
# DEBUGGING coverage test, see STATUS for the missing test ops.
# The real coverage tests are in asmdata.t
if ($do_coverage and $DEBUGGING) {
my $zeros = '';
use B::Asmdata q(@insn_name);
for (0..$#insn_name) { $zeros .= ($insn_name[$_]."($_) ") unless $insncov{$_} };
if ($zeros) { print "not ok ",$cnt++," # TODO no coverage for: $zeros"; }
else { print "ok ",$cnt++," # TODO coverage unexpectedly passed";}
}
Jump to Line
Something went wrong with that request. Please try again.