This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Silence compiler warnings
[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;
1cecd13c 27use Test::More tests => 11;
93f00e88
RU
28use B;
29use B::Debug;
87a42246
MS
30
31my $a;
32my $Is_VMS = $^O eq 'VMS';
33my $Is_MacOS = $^O eq 'MacOS';
1cecd13c 34my $X = $^X =~ m/\s/ ? qq{"$^X"} : $^X;
87a42246
MS
35
36my $path = join " ", map { qq["-I$_"] } @INC;
37my $redir = $Is_MacOS ? "" : "2>&1";
38
1cecd13c 39$a = `$X $path "-MO=Debug" -e 1 $redir`;
f071ed12 40like($a, qr/\bLISTOP\b.*\bOP\b.*\bCOP\b.*\bOP\b/s);
87a42246
MS
41
42
1cecd13c 43$a = `$X $path "-MO=Terse" -e 1 $redir`;
f071ed12 44like($a, qr/\bLISTOP\b.*leave.*\n OP\b.*enter.*\n COP\b.*nextstate.*\n OP\b.*null/s);
87a42246 45
1cecd13c 46$a = `$X $path "-MO=Terse" -ane "s/foo/bar/" $redir`;
87a42246
MS
47$a =~ s/\(0x[^)]+\)//g;
48$a =~ s/\[[^\]]+\]//g;
49$a =~ s/-e syntax OK//;
50$a =~ s/[^a-z ]+//g;
51$a =~ s/\s+/ /g;
52$a =~ s/\b(s|foo|bar|ullsv)\b\s?//g;
53$a =~ s/^\s+//;
54$a =~ s/\s+$//;
85da676d 55$a =~ s/\s+nextstate$//; # if $] < 5.008001; # 5.8.0 adds it. 5.8.8 not anymore
87a42246
MS
56my $is_thread = $Config{use5005threads} && $Config{use5005threads} eq 'define';
57if ($is_thread) {
58 $b=<<EOF;
59leave enter nextstate label leaveloop enterloop null and defined null
60threadsv readline gv lineseq nextstate aassign null pushmark split pushre
241416b8 61threadsv const null pushmark rvav gv nextstate subst const unstack
87a42246
MS
62EOF
63} else {
85da676d
DM
64 $b=<<EOF;
65leave enter nextstate label leaveloop enterloop null and defined null null
66gvsv readline gv lineseq nextstate aassign null pushmark split pushre null
67gvsv const null pushmark rvav gv nextstate subst const unstack
87a42246
MS
68EOF
69}
85da676d 70#$b .= " nextstate" if $] < 5.008001; # ??
1cecd13c 71$b=~s/\n/ /g; $b=~s/\s+/ /g;
87a42246 72$b =~ s/\s+$//;
f071ed12 73is($a, $b);
87a42246 74
93f00e88
RU
75like(B::Debug::_printop(B::main_root), qr/LISTOP\s+\[OP_LEAVE\]/);
76like(B::Debug::_printop(B::main_start), qr/OP\s+\[OP_ENTER\]/);
77
1cecd13c 78$a = `$X $path "-MO=Debug" -e "B::main_root->debug" $redir`;
93f00e88 79like($a, qr/op_next\s+0x0/m);
1cecd13c
RU
80$a = `$X $path "-MO=Debug" -e "B::main_start->debug" $redir`;
81like($a, qr/\[OP_ENTER\]/m);
85da676d
DM
82
83# pass missing FETCHSIZE, fixed with 1.06
84my $tmp = "tmp.pl";
85open TMP, "> $tmp";
86print TMP 'BEGIN{tie @a, __PACKAGE__;sub TIEARRAY {bless{}} sub FETCH{1}};
87print $a[1]';
88close TMP;
1cecd13c 89$a = `$X $path "-MO=Debug" $tmp $redir`;
85da676d
DM
90unlink $tmp;
91unlike($a, qr/locate object method "FETCHSIZE"/m);
1cecd13c
RU
92
93# NV assertion with CV, fixed with 1.13
94my $e = 'my $p=1;$g=2;sub p($){my $i=1;$i+1};print p(0)+$g;';
95$a = `$X $path "-MO=Debug" -e'$e' $redir`;
96ok(! $?);
97unlike($a, qr/assertion "SvTYPE(sv) != SVt_PVCV" failed.*function: S_sv_2iuv_common/m);
98unlike($a, qr/Use of uninitialized value in print/m);
99
100END { unlink $tmp; }