From: Reini Urban Date: Wed, 11 Jun 2008 17:03:37 +0000 (+0200) Subject: B::Debug dual-life 1.06 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=93f00e883ad68ff380fcf0334a89dd0d13538eb7;p=p5sagit%2Fp5-mst-13.2.git B::Debug dual-life 1.06 Message-ID: <484FE949.9040701@x-ray.at> p4raw-id: //depot/perl@34045 --- diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index e3146b2..fe746b2 100644 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -65,6 +65,7 @@ package Maintainers; 'rkobes' => 'Randy Kobes ', 'rmbarker' => 'Robin Barker ', 'rra' => 'Russ Allbery ', + 'rurban' => 'Reini Urban ', 'sadahiro' => 'SADAHIRO Tomoyuki ', 'salva' => 'Salvador Fandiño García ', 'saper' => 'Sébastien Aperghis-Tramoni ', @@ -123,6 +124,13 @@ package Maintainers; 'CPAN' => 0, }, + 'B::Debug' => + { + 'MAINTAINER' => 'rurban', + 'FILES' => q[ext/B/B/Debug.pm ext/B/t/debug.t], + 'CPAN' => 1, + }, + 'B::Deparse' => { 'MAINTAINER' => 'smccam', diff --git a/ext/B/B/Debug.pm b/ext/B/B/Debug.pm index 970f221..ad3c215 100644 --- a/ext/B/B/Debug.pm +++ b/ext/B/B/Debug.pm @@ -1,11 +1,20 @@ package B::Debug; -our $VERSION = '1.05_02'; +our $VERSION = '1.06'; use strict; use B qw(peekop class walkoptree walkoptree_exec - main_start main_root cstring sv_undef @specialsv_name); -# <=5.008 had @specialsv_name exported from B::Asmdata + main_start main_root cstring sv_undef); +our (@optype, @specialsv_name); +require B; +if ($] < 5.009) { + require B::Asmdata; + B::Asmdata->import qw(@optype @specialsv_name); +} else { + B->import qw(@optype @specialsv_name); +} +my $have_B_Flags; +eval { require B::Flags and $have_B_Flags++ }; BEGIN { use Config; my $ithreads = $Config{'useithreads'} eq 'define'; @@ -34,7 +43,7 @@ sub B::OP::debug { op_targ %d op_type %d EOT - if ($] > 5.009) { + if (VERSION > 5.009) { printf <<'EOT', $op->opt; op_opt %d EOT @@ -43,10 +52,17 @@ EOT op_seq %d EOT } - printf <<'EOT', $op->flags, $op->private; + if ($have_B_Flags) { + printf <<'EOT', $op->flags, $op->flagspv, $op->private, $op->privatepv; + op_flags %d %s + op_private %d %s +EOT + } else { + printf <<'EOT', $op->flags, $op->private; op_flags %d op_private %d EOT + } } sub B::UNOP::debug { @@ -86,21 +102,21 @@ sub B::LISTOP::debug { sub B::PMOP::debug { my ($op) = @_; $op->B::LISTOP::debug(); - printf "\top_pmreplroot\t0x%x\n", ${$op->pmreplroot}; + printf "\top_pmreplroot\t0x%x\n", VERSION < 5.008 ? ${$op->pmreplroot} : $op->pmreplroot; printf "\top_pmreplstart\t0x%x\n", ${$op->pmreplstart}; - printf "\top_pmnext\t0x%x\n", ${$op->pmnext} if $] < 5.009005; + printf "\top_pmnext\t0x%x\n", ${$op->pmnext} if VERSION < 5.009005; if (ITHREADS) { printf "\top_pmstashpv\t%s\n", cstring($op->pmstashpv); printf "\top_pmoffset\t%d\n", $op->pmoffset; } else { printf "\top_pmstash\t%s\n", cstring($op->pmstash); } - printf "\top_precomp->precomp\t%s\n", cstring($op->precomp); + printf "\top_precomp\t%s\n", cstring($op->precomp); printf "\top_pmflags\t0x%x\n", $op->pmflags; - printf "\top_reflags\t0x%x\n", $op->reflags if $] >= 5.009; - printf "\top_pmpermflags\t0x%x\n", $op->pmpermflags if $] < 5.009; - printf "\top_pmdynflags\t0x%x\n", $op->pmdynflags if $] < 5.009; - $op->pmreplroot->debug; + printf "\top_reflags\t0x%x\n", $op->reflags if VERSION >= 5.009; + printf "\top_pmpermflags\t0x%x\n", $op->pmpermflags if VERSION < 5.009; + printf "\top_pmdynflags\t0x%x\n", $op->pmdynflags if VERSION < 5.009; + $op->pmreplroot->debug if VERSION < 5.008; } sub B::COP::debug { @@ -248,14 +264,23 @@ EOT sub B::AV::debug { my ($av) = @_; $av->B::SV::debug; - my(@array) = $av->ARRAY; + # tied arrays may leave out FETCHSIZE + my (@array) = eval { $av->ARRAY; }; print "\tARRAY\t\t(", join(", ", map("0x" . $$_, @array)), ")\n"; - printf <<'EOT', scalar(@array), $av->MAX, $av->OFF; + my $fill = eval { scalar(@array) }; + if (ITHREADS) { + printf <<'EOT', $fill, $av->MAX, $av->OFF; FILL %d MAX %d OFF %d EOT - printf <<'EOT', $av->AvFLAGS if $] < 5.009; + } else { + printf <<'EOT', $fill, $av->MAX; + FILL %d + MAX %d +EOT + } + printf <<'EOT', $av->AvFLAGS if VERSION < 5.009; AvFLAGS %d EOT } @@ -326,8 +351,31 @@ See F and the newer L, L. With option -exec, walks tree in execute order, otherwise in basic order. +=head1 Changes + + 1.06 2008-06-11 rurban + added B::Flags output + dual-life CPAN as B-Debug-1.06 and CORE + protect scalar(@array) if tied arrays leave out FETCHSIZE + + 1.05_03 2008-04-16 rurban + ithread fixes in B::AV + B-C-1.04_?? + + B-C-1.04_09 2008-02-24 rurban + support 5.8 (import Asmdata) + + 1.05_02 2008-02-21 rurban + added _printop + B-C-1.04_08 and CORE + + 1.05_01 2008-02-05 rurban + 5.10 fix for op->seq + B-C-1.04_04 + =head1 AUTHOR Malcolm Beattie, C +Reini Urban C =cut diff --git a/ext/B/t/debug.t b/ext/B/t/debug.t index 225385e..26ed61c 100755 --- a/ext/B/t/debug.t +++ b/ext/B/t/debug.t @@ -1,6 +1,7 @@ #!./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') { @@ -23,7 +24,9 @@ $| = 1; use warnings; use strict; use Config; -use Test::More tests=>3; +use Test::More tests => 7; +use B; +use B::Debug; my $a; my $Is_VMS = $^O eq 'VMS'; @@ -66,3 +69,10 @@ $b=~s/\n/ /g;$b=~s/\s+/ /g; $b =~ s/\s+$//; 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/PL_ppaddr\[OP_ENTER\]/m);