This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate CPAN release of version.pm 0.9905
[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;
e86c8c9d 30use File::Spec;
87a42246
MS
31
32my $a;
1cecd13c 33my $X = $^X =~ m/\s/ ? qq{"$^X"} : $^X;
87a42246 34
e86c8c9d
SH
35my $path = join " ", map { qq["-I$_"] } (File::Spec->catfile("blib","lib"), @INC);
36my $redir = $^O =~ /VMS|MSWin32|MacOS/ ? "" : "2>&1";
87a42246 37
1cecd13c 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
1cecd13c 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 44
1cecd13c 45$a = `$X $path "-MO=Terse" -ane "s/foo/bar/" $redir`;
87a42246
MS
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; # ??
1cecd13c 70$b=~s/\n/ /g; $b=~s/\s+/ /g;
87a42246 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
1cecd13c 77$a = `$X $path "-MO=Debug" -e "B::main_root->debug" $redir`;
93f00e88 78like($a, qr/op_next\s+0x0/m);
1cecd13c
RU
79$a = `$X $path "-MO=Debug" -e "B::main_start->debug" $redir`;
80like($a, qr/\[OP_ENTER\]/m);
85da676d
DM
81
82# pass missing FETCHSIZE, fixed with 1.06
e86c8c9d
SH
83my $e = q(BEGIN{tie @a, __PACKAGE__;sub TIEARRAY {bless{}} sub FETCH{1}};print $a[1]);
84$a = `$X $path "-MO=Debug" -e"$e" $redir`;
85da676d 85unlike($a, qr/locate object method "FETCHSIZE"/m);
1cecd13c
RU
86
87# NV assertion with CV, fixed with 1.13
e86c8c9d
SH
88my $tmp = "tmp.pl";
89open TMP, ">", $tmp;
90print TMP 'my $p=1;$g=2;sub p($){my $i=1;$i+1};print p(0)+$g;';
91close TMP;
92$a = `$X $path "-MO=Debug" $tmp $redir`;
1cecd13c
RU
93ok(! $?);
94unlike($a, qr/assertion "SvTYPE(sv) != SVt_PVCV" failed.*function: S_sv_2iuv_common/m);
95unlike($a, qr/Use of uninitialized value in print/m);
96
e86c8c9d 97END { unlink $tmp if $tmp; }