This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
segfault on &Internals::* due to missing SvROK()
[perl5.git] / cpan / B-Debug / t / debug.t
CommitLineData
87a42246
MS
1#!./perl
2
3BEGIN {
93f00e88 4 delete $ENV{PERL_DL_NONLAZY} if $] < 5.005_58; #Perl_byterun problem
5638aaac
SM
5 if ($ENV{PERL_CORE}){
6 chdir('t') if -d 't';
7 if ($^O eq 'MacOS') {
8 @INC = qw(: ::lib ::macos:lib);
9 } else {
10 @INC = '.';
11 push @INC, '../lib';
12 }
87a42246 13 } else {
5638aaac 14 unshift @INC, 't';
87a42246 15 }
9cd8f857
NC
16 require Config;
17 if (($Config::Config{'extensions'} !~ /\bB\b/) ){
18 print "1..0 # Skip -- Perl configured without B module\n";
19 exit 0;
20 }
87a42246
MS
21}
22
23$| = 1;
24use warnings;
25use strict;
26use Config;
85da676d 27use Test::More tests => 8;
93f00e88
RU
28use B;
29use B::Debug;
87a42246
MS
30
31my $a;
32my $Is_VMS = $^O eq 'VMS';
33my $Is_MacOS = $^O eq 'MacOS';
34
35my $path = join " ", map { qq["-I$_"] } @INC;
36my $redir = $Is_MacOS ? "" : "2>&1";
37
38$a = `$^X $path "-MO=Debug" -e 1 $redir`;
f071ed12 39like($a, qr/\bLISTOP\b.*\bOP\b.*\bCOP\b.*\bOP\b/s);
87a42246
MS
40
41
42$a = `$^X $path "-MO=Terse" -e 1 $redir`;
f071ed12 43like($a, qr/\bLISTOP\b.*leave.*\n OP\b.*enter.*\n COP\b.*nextstate.*\n OP\b.*null/s);
87a42246
MS
44
45$a = `$^X $path "-MO=Terse" -ane "s/foo/bar/" $redir`;
46$a =~ s/\(0x[^)]+\)//g;
47$a =~ s/\[[^\]]+\]//g;
48$a =~ s/-e syntax OK//;
49$a =~ s/[^a-z ]+//g;
50$a =~ s/\s+/ /g;
51$a =~ s/\b(s|foo|bar|ullsv)\b\s?//g;
52$a =~ s/^\s+//;
53$a =~ s/\s+$//;
85da676d 54$a =~ s/\s+nextstate$//; # if $] < 5.008001; # 5.8.0 adds it. 5.8.8 not anymore
87a42246
MS
55my $is_thread = $Config{use5005threads} && $Config{use5005threads} eq 'define';
56if ($is_thread) {
57 $b=<<EOF;
58leave enter nextstate label leaveloop enterloop null and defined null
59threadsv readline gv lineseq nextstate aassign null pushmark split pushre
241416b8 60threadsv const null pushmark rvav gv nextstate subst const unstack
87a42246
MS
61EOF
62} else {
85da676d
DM
63 $b=<<EOF;
64leave enter nextstate label leaveloop enterloop null and defined null null
65gvsv readline gv lineseq nextstate aassign null pushmark split pushre null
66gvsv const null pushmark rvav gv nextstate subst const unstack
87a42246
MS
67EOF
68}
85da676d 69#$b .= " nextstate" if $] < 5.008001; # ??
87a42246
MS
70$b=~s/\n/ /g;$b=~s/\s+/ /g;
71$b =~ s/\s+$//;
f071ed12 72is($a, $b);
87a42246 73
93f00e88
RU
74like(B::Debug::_printop(B::main_root), qr/LISTOP\s+\[OP_LEAVE\]/);
75like(B::Debug::_printop(B::main_start), qr/OP\s+\[OP_ENTER\]/);
76
cba5fa5d 77$a = `$^X $path "-MO=Debug" -e "B::main_root->debug" $redir`;
93f00e88 78like($a, qr/op_next\s+0x0/m);
cba5fa5d 79$a = `$^X $path "-MO=Debug" -e "B::main_start->debug" $redir`;
93f00e88 80like($a, qr/PL_ppaddr\[OP_ENTER\]/m);
85da676d
DM
81
82# pass missing FETCHSIZE, fixed with 1.06
83my $tmp = "tmp.pl";
84open TMP, "> $tmp";
85print TMP 'BEGIN{tie @a, __PACKAGE__;sub TIEARRAY {bless{}} sub FETCH{1}};
86print $a[1]';
87close TMP;
88$a = `$^X $path "-MO=Debug" $tmp $redir`;
89unlink $tmp;
90unlike($a, qr/locate object method "FETCHSIZE"/m);