padname values may have bogus SvCUR

Message-ID: <20010402225410.A8273@puffinry.freeserve.co.uk>

p4raw-id: //depot/perl@9522

diff --git a/ext/B/B.pm b/ext/B/B.pm
index 2ab1898..41ba5d6 100644 (file)
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -365,6 +365,8 @@ C<REFCNT> (corresponding to the C function C<SvREFCNT>).
 
 =item PV
 
+=item PVX
+
 =back
 
 =head2 B::PVMG METHODS

diff --git a/ext/B/B.xs b/ext/B/B.xs
index fc97c43..51ce983 100644 (file)
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -901,6 +901,10 @@ SvRV(sv)
 
 MODULE = B     PACKAGE = B::PV         PREFIX = Sv
 
+char*
+SvPVX(sv)
+       B::PV   sv
+
 void
 SvPV(sv)
        B::PV   sv

diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index 900a70a..2dd43a9 100644 (file)
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -326,7 +326,7 @@ sub concise_op {
     } elsif ($h{targ}) {
        my $padname = (($curcv->PADLIST->ARRAY)[0]->ARRAY)[$h{targ}];
        if (defined $padname and class($padname) ne "SPECIAL") {
-           $h{targarg}  = $padname->PV;
+           $h{targarg}  = $padname->PVX;
            my $intro = $padname->NVX - $cop_seq_base;
            my $finish = int($padname->IVX) - $cop_seq_base;
            $finish = "end" if $finish == 999999999 - $cop_seq_base;

diff --git a/ext/B/B/Showlex.pm b/ext/B/B/Showlex.pm
index 648f95d..842ca3e 100644 (file)
--- a/ext/B/B/Showlex.pm
+++ b/ext/B/B/Showlex.pm
@@ -12,7 +12,24 @@ use B::Terse ();
 # to see the names of file scope lexicals used by bar.pl
 #    
 
-sub showarray {
+sub shownamearray {
+    my ($name, $av) = @_;
+    my @els = $av->ARRAY;
+    my $count = @els;
+    my $i;
+    print "$name has $count entries\n";
+    for ($i = 0; $i < $count; $i++) {
+        print "$i: ";
+       my $sv = $els[$i];
+       if (class($sv) ne "SPECIAL") {
+           printf "%s (0x%lx) %s\n", class($sv), $$sv, $sv->PVX;
+       } else {
+            $sv->terse;
+       }
+    }
+}
+
+sub showvaluearray {
     my ($name, $av) = @_;
     my @els = $av->ARRAY;
     my $count = @els;
@@ -26,8 +43,8 @@ sub showarray {
 
 sub showlex {
     my ($objname, $namesav, $valsav) = @_;
-    showarray("Pad of lexical names for $objname", $namesav);
-    showarray("Pad of lexical values for $objname", $valsav);
+    shownamearray("Pad of lexical names for $objname", $namesav);
+    showvaluearray("Pad of lexical values for $objname", $valsav);
 }
 
 sub showlex_obj {