Change 34045 by [EMAIL PROTECTED] on 2008/06/13 12:23:12
Subject: [PATCH] B::Debug dual-life 1.06
From: Reini Urban <[EMAIL PROTECTED]>
Date: Wed, 11 Jun 2008 17:03:37 +0200
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/Porting/Maintainers.pl#112 edit
... //depot/perl/ext/B/B/Debug.pm#33 edit
... //depot/perl/ext/B/t/debug.t#6 edit
Differences ...
==== //depot/perl/Porting/Maintainers.pl#112 (text) ====
Index: perl/Porting/Maintainers.pl
--- perl/Porting/Maintainers.pl#111~34028~ 2008-06-08 08:10:28.000000000
-0700
+++ perl/Porting/Maintainers.pl 2008-06-13 05:23:12.000000000 -0700
@@ -65,6 +65,7 @@
'rkobes' => 'Randy Kobes <[EMAIL PROTECTED]>',
'rmbarker' => 'Robin Barker <[EMAIL PROTECTED]>',
'rra' => 'Russ Allbery <[EMAIL PROTECTED]>',
+ 'rurban' => 'Reini Urban <[EMAIL PROTECTED]>',
'sadahiro' => 'SADAHIRO Tomoyuki <[EMAIL PROTECTED]>',
'salva' => 'Salvador Fandiño García <[EMAIL PROTECTED]>',
'saper' => 'Sébastien Aperghis-Tramoni <[EMAIL PROTECTED]>',
@@ -123,6 +124,13 @@
'CPAN' => 0,
},
+ 'B::Debug' =>
+ {
+ 'MAINTAINER' => 'rurban',
+ 'FILES' => q[ext/B/B/Debug.pm ext/B/t/debug.t],
+ 'CPAN' => 1,
+ },
+
'B::Deparse' =>
{
'MAINTAINER' => 'smccam',
==== //depot/perl/ext/B/B/Debug.pm#33 (text) ====
Index: perl/ext/B/B/Debug.pm
--- perl/ext/B/B/Debug.pm#32~33363~ 2008-02-24 23:46:17.000000000 -0800
+++ perl/ext/B/B/Debug.pm 2008-06-13 05:23:12.000000000 -0700
@@ -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 @@
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 @@
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::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 @@
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 @@
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<[EMAIL PROTECTED]>
+Reini Urban C<[EMAIL PROTECTED]>
=cut
==== //depot/perl/ext/B/t/debug.t#6 (xtext) ====
Index: perl/ext/B/t/debug.t
--- perl/ext/B/t/debug.t#5~30052~ 2007-01-28 14:30:18.000000000 -0800
+++ perl/ext/B/t/debug.t 2008-06-13 05:23:12.000000000 -0700
@@ -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 @@
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/\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);
End of Patch.
