/
bytecode.t
173 lines (165 loc) · 6.18 KB
/
bytecode.t
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
#! /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 ((!-d '.git' or $ENV{NO_AUTHOR}) and $] >= 5.018 and $Config{useithreads}) {
print "1..0 # skip - bytecode 5.18 threaded broken\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) if $] >= 5.010 and !$ITHREADS;
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 and $] < 5.018;
#push @todo, (27,29) if $] >= 5.018;
push @todo, (16) if $] >= 5.018 and $ITHREADS;
#push @todo, (41..43) if $] >= 5.010; #freebsd
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$//;
if ($cnt == 4 and $] >= 5.018) {
$expect = "zz" . $expect;
}
$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";}
}