#!./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=<= 5.021005) { $b=<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; }