cope with SVf_IVisUV, and cope with $^^ and friends

Message-ID: <20010405164517.B16037@puffinry.freeserve.co.uk>

p4raw-id: //depot/perl@9566

diff --git a/ext/B/B.pm b/ext/B/B.pm
index 6c2f013..7ee1d19 100644 (file)
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -62,10 +62,19 @@ use strict;
 
 sub B::GV::SAFENAME {
   my $name = (shift())->NAME;
-  $name =~ s/^([\cA-\cZ])/"^".chr(64 + ord($1))/e;
+
+  # The regex below corresponds to the isCONTROLVAR macro
+  # from toke.c
+
+  $name =~ s/^([\cA-\cZ\c\\c[\c]\c?\c_\c^])/"^".chr(64 ^ ord($1))/e;
   return $name;
 }
 
+sub B::IV::int_value {
+  my ($self) = @_;
+  return (($self->FLAGS() & SVf_IVisUV()) ? $self->UVX : $self->IV);
+}
+
 my $debug;
 my $op_count = 0;
 my @parents = ();
@@ -339,8 +348,22 @@ C<REFCNT> (corresponding to the C function C<SvREFCNT>).
 
 =item IV
 
+Returns the value of the IV, I<interpreted as
+a signed integer>. This will be misleading
+if C<FLAGS & SVf_IVisUV>. Perhaps you want the
+C<int_value> method instead?
+
 =item IVX
 
+=item UVX
+
+=item int_value
+
+This method returns the value of the IV as an integer.
+It differs from C<IV> in that it returns the correct
+value regardless of whether it's stored signed or
+unsigned.
+
 =item needs64bits
 
 =item packiv

diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm
index a16fe77..fa402cb 100644 (file)
--- a/ext/B/B/Deparse.pm
+++ b/ext/B/B/Deparse.pm
@@ -774,7 +774,7 @@ sub gv_name {
     my $self = shift;
     my $gv = shift;
     my $stash = $gv->STASH->NAME;
-    my $name = $gv->NAME;
+    my $name = $gv->SAFENAME;
     if ($stash eq $self->{'curstash'} or $globalnames{$name}
        or $name =~ /^[^A-Za-z_]/)
     {
@@ -782,9 +782,8 @@ sub gv_name {
     } else {
        $stash = $stash . "::";
     }
-    if ($name =~ /^([\cA-\cZ])(.*)$/) {
-       $name = "^" . chr(64 + ord($1)) . $2;
-       $name = "{$name}" if length($2);        # ${^WARNING_BITS} etc
+    if ($name =~ /^\^../) {
+        $name = "{$name}";       # ${^WARNING_BITS} etc
     }
     return $stash . $name;
 }
@@ -2375,7 +2374,7 @@ sub const {
     if (class($sv) eq "SPECIAL") {
        return ('undef', '1', '0')[$$sv-1]; # sv_undef, sv_yes, sv_no
     } elsif ($sv->FLAGS & SVf_IOK) {
-       return $sv->IV;
+       return $sv->int_value;
     } elsif ($sv->FLAGS & SVf_NOK) {
        return $sv->NV;
     } elsif ($sv->FLAGS & SVf_ROK) {

diff --git a/ext/B/B/Terse.pm b/ext/B/B/Terse.pm
index bf4ef4b..52f0549 100644 (file)
--- a/ext/B/B/Terse.pm
+++ b/ext/B/B/Terse.pm
@@ -1,7 +1,7 @@
 package B::Terse;
 use strict;
 use B qw(peekop class walkoptree walkoptree_exec walkoptree_slow
-        main_start main_root cstring svref_2object);
+        main_start main_root cstring svref_2object SVf_IVisUV);
 use B::Asmdata qw(@specialsv_name);
 
 sub terse {
@@ -108,7 +108,8 @@ sub B::GV::terse {
 sub B::IV::terse {
     my ($sv, $level) = @_;
     print indent($level);
-    printf "%s (0x%lx) %d\n", class($sv), $$sv, $sv->IV;
+    my $v = $sv->FLAGS & SVf_IVisUV ? "%u" : "%d";
+    printf "%s (0x%lx) $v\n", class($sv), $$sv, $sv->int_value;
 }
 
 sub B::NV::terse {