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
|
#!./perl
BEGIN {
delete $ENV{PERL_DL_NONLAZY} if $] < 5.005_58; #Perl_byterun problem
if ($ENV{PERL_CORE}){
chdir('t') if -d 't';
if ($^O eq 'MacOS') {
@INC = qw(: ::lib ::macos:lib);
} else {
@INC = '.';
push @INC, '../lib';
}
} else {
unshift @INC, 't';
}
require Config;
if (($Config::Config{'extensions'} !~ /\bB\b/) ){
print "1..0 # Skip -- Perl configured without B module\n";
exit 0;
}
}
$| = 1;
use warnings;
use strict;
use Config;
use Test::More tests => 11;
use B;
use B::Debug;
use File::Spec;
my $a;
my $X = $^X =~ m/\s/ ? qq{"$^X"} : $^X;
my $path = join " ", map { qq["-I$_"] } (File::Spec->catfile("blib","lib"), @INC);
my $redir = $^O =~ /VMS|MSWin32|MacOS/ ? "" : "2>&1";
$a = `$X $path "-MO=Debug" -e 1 $redir`;
like($a, qr/\bLISTOP\b.*\bOP\b.*\bCOP\b.*\bOP\b/s);
$a = `$X $path "-MO=Terse" -e 1 $redir`;
like($a, qr/\bLISTOP\b.*leave.*\n OP\b.*enter.*\n COP\b.*nextstate.*\n OP\b.*null/s);
$a = `$X $path "-MO=Terse" -ane "s/foo/bar/" $redir`;
$a =~ s/\(0x[^)]+\)//g;
$a =~ s/\[[^\]]+\]//g;
$a =~ s/-e syntax OK//;
$a =~ s/[^a-z ]+//g;
$a =~ s/\s+/ /g;
$a =~ s/\b(s|foo|bar|ullsv)\b\s?//g;
$a =~ s/^\s+//;
$a =~ s/\s+$//;
$a =~ s/\s+nextstate$//; # if $] < 5.008001; # 5.8.0 adds it. 5.8.8 not anymore
my $is_thread = $Config{use5005threads} && $Config{use5005threads} eq 'define';
if ($is_thread) {
$b=<<EOF;
leave enter nextstate label leaveloop enterloop null and defined null
threadsv readline gv lineseq nextstate aassign null pushmark split pushre
threadsv const null pushmark rvav gv nextstate subst const unstack
EOF
} elsif ($] >= 5.021005) {
$b=<<EOF;
leave enter nextstate label leaveloop enterloop null and defined null null
gvsv readline gv lineseq nextstate split pushre null
gvsv const nextstate subst const unstack
EOF
} else {
$b=<<EOF;
leave enter nextstate label leaveloop enterloop null and defined null null
gvsv readline gv lineseq nextstate aassign null pushmark split pushre null
gvsv const null pushmark rvav gv nextstate subst const unstack
EOF
}
#$b .= " nextstate" if $] < 5.008001; # ??
$b=~s/\n/ /g; $b=~s/\s+/ /g;
$b =~ s/\s+$//;
TODO: {
local $TODO = '5.21.5 split optimization' if $] == 5.021005;
is($a, $b);
}
like(B::Debug::_printop(B::main_root), qr/LISTOP\s+\[OP_LEAVE\]/);
like(B::Debug::_printop(B::main_start), qr/OP\s+\[OP_ENTER\]/);
$a = `$X $path "-MO=Debug" -e "B::main_root->debug" $redir`;
like($a, qr/op_next\s+0x0/m);
$a = `$X $path "-MO=Debug" -e "B::main_start->debug" $redir`;
like($a, qr/\[OP_ENTER\]/m);
# pass missing FETCHSIZE, fixed with 1.06
my $e = q(BEGIN{tie @a, __PACKAGE__;sub TIEARRAY {bless{}} sub FETCH{1}};print $a[1]);
$a = `$X $path "-MO=Debug" -e"$e" $redir`;
unlike($a, qr/locate object method "FETCHSIZE"/m);
# NV assertion with CV, fixed with 1.13
my $tmp = "tmp.pl";
open TMP, ">", $tmp;
print TMP 'my $p=1;$g=2;sub p($){my $i=1;$i+1};print p(0)+$g;';
close TMP;
$a = `$X $path "-MO=Debug" $tmp $redir`;
ok(! $?);
unlike($a, qr/assertion "SvTYPE(sv) != SVt_PVCV" failed.*function: S_sv_2iuv_common/m);
unlike($a, qr/Use of uninitialized value in print/m);
END { unlink $tmp if $tmp; }
|
