develooper Front page | perl.perl5.porters | Postings from August 2012

Fwd: [rt.cpan.org #79028] Fix to work with B::PADLIST

From:
bug-B-Debug
Date:
August 16, 2012 16:58
Subject:
Fwd: [rt.cpan.org #79028] Fix to work with B::PADLIST
Message ID:
20120816235836.CA2037047@cpan.rt.develooper.com
Subject: Fix to work with B::PADLIST
MIME-Version: 1.0
X-Mailer: MIME-tools 5.427 (Entity 5.427)
X-RT-Original-Encoding: utf-8
Content-Type: multipart/mixed; boundary="----------=_1345161516-24808-1"

This is a multi-part message in MIME format...

------------=_1345161516-24808-1
Content-Length: 439
Content-Type: text/plain; charset="UTF-8"
Content-Disposition: inline
Content-Transfer-Encoding: binary

In trying to fix a perl bug, I have found the need to stop padlists from being AVs.

See the branch I pushed to 
<http://perl5.git.perl.org/perl.git/shortlog/refs/heads/sprout/padlist>.  (It’s not finished yet.  
It still needs docs.)

This breaks B::Debug, because svref_2object(sub{})->PADLIST now returns an object of type 
B::PADLIST.

Attached is a patch to fix it.

I eagerly await a new release, so I can merge this to blead. :-)

------------=_1345161516-24808-1
Subject: open_esbBLVyO.txt
MIME-Version: 1.0
Content-Type: text/plain; charset="ascii"; name="open_esbBLVyO.txt"
X-Mailer: MIME-tools 5.427 (Entity 5.427)
Content-Disposition: inline; filename="open_esbBLVyO.txt"
Content-Transfer-Encoding: binary
X-RT-Original-Encoding: ascii
Content-Length: 1100

diff -rup B-Debug-1.17-DsWHyx-orig/Debug.pm B-Debug-1.17-DsWHyx/Debug.pm
--- B-Debug-1.17-DsWHyx-orig/Debug.pm	2011-11-25 13:52:30.000000000 -0800
+++ B-Debug-1.17-DsWHyx/Debug.pm	2012-08-16 16:57:28.000000000 -0700
@@ -285,11 +285,16 @@ EOT
 sub B::AV::debug {
     my ($av) = @_;
     $av->B::SV::debug;
+    _array_debug($av);
+}
+
+sub _array_debug {
+    my ($av) = @_;
     # tied arrays may leave out FETCHSIZE
     my (@array) = eval { $av->ARRAY; };
     print "\tARRAY\t\t(", join(", ", map("0x" . $$_, @array)), ")\n";
     my $fill = eval { scalar(@array) };
-    if ($Config{'useithreads'}) {
+    if ($Config{'useithreads'} && class($av) ne 'PADLIST') {
       printf <<'EOT', $fill, $av->MAX, $av->OFF;
 	FILL		%d
 	MAX		%d
@@ -353,6 +358,15 @@ sub B::SPECIAL::debug {
     print exists $specialsv_name[$i] ? $specialsv_name[$i] : "", "\n";
 }
 
+sub B::PADLIST::debug {
+    my ($padlist) = @_;
+    printf <<'EOT', class($padlist), $$padlist, $padlist->REFCNT;
+%s (0x%x)
+	REFCNT		%d
+EOT
+    _array_debug($padlist);
+}
+
 sub compile {
     my $order = shift;
     B::clearsym();

------------=_1345161516-24808-1--



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About