[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]
[PATCH] B::Debug dual-life 1.06
I want to maintain B::Debug seperately.
Attached patch merges my latest enhancements and adds the dual-life notice.
I know it's just a stupid little module, but nevertheless I need to
enhance it while working on the perl compiler and B::Debugger.
And I don't want to include my enhanced versions in the upcoming
non-developers B-C release.
And I'd like to have those B-Debug enhancements as well as the B
compiler enhancements in previous perl's also. (e.g. platform
independent bytecode, B::CC fixes, ...).
And I'd like to get seperate bugreports on the seperate CPAN tracker.
I already got the pause perms for it and will upload the full CPAN
module after acceptance. For now it's at
http://rurban.xarch.at/cygr/perl/B-Debug-1.06.tar.gz
--
Reini Urban
http://phpwiki.org/ http://murbreak.at/
difforig ext/B/t/debug.t ext/B/B/Debug.pm Porting/Maintainers.pl
2008-06-11 rurban@cpan.org
* make it B::Debug dual-life, sync with B-Debug-1.06
* add B::Flags if available
* added 4 tests
* protect scalar(@array) if tied arrays leave out FETCHSIZE
diff -u ext/B/t/debug.t.orig ext/B/t/debug.t
--- ext/B/t/debug.t.orig 2007-01-28 22:31:47.000000000 +0000
+++ ext/B/t/debug.t 2008-06-11 14:06:19.484375000 +0000
@@ -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);
diff -u ext/B/B/Debug.pm.orig ext/B/B/Debug.pm
--- ext/B/B/Debug.pm.orig 2008-02-25 07:48:39.000000000 +0000
+++ ext/B/B/Debug.pm 2008-06-11 14:59:26.796875000 +0000
@@ -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<mbeattie@sable.ox.ac.uk>
+Reini Urban C<rurban@cpan.org>
=cut
diff -u Porting/Maintainers.pl.orig Porting/Maintainers.pl
--- Porting/Maintainers.pl.orig 2008-06-08 15:13:48.000000000 +0000
+++ Porting/Maintainers.pl 2008-06-11 14:30:03.625000000 +0000
@@ -65,6 +65,7 @@
'rkobes' => 'Randy Kobes <rkobes@cpan.org>',
'rmbarker' => 'Robin Barker <rmbarker@cpan.org>',
'rra' => 'Russ Allbery <rra@cpan.org>',
+ 'rurban' => 'Reini Urban <rurban@cpan.org>',
'sadahiro' => 'SADAHIRO Tomoyuki <SADAHIRO@cpan.org>',
'salva' => 'Salvador Fandiño García <salva@cpan.org>',
'saper' => 'Sébastien Aperghis-Tramoni <saper@cpan.org>',
@@ -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',
- Follow-Ups from:
-
"Rafael Garcia-Suarez" <rgarciasuarez@gmail.com>
[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]