Change PerlIO::Scalar and Via to scalar and via.

[p5sagit/p5-mst-13.2.git] / ext / B / B / Terse.pm

diff --git a/ext/B/B/Terse.pm b/ext/B/B/Terse.pm
index 6489dc0..3abe615 100644 (file)
--- a/ext/B/B/Terse.pm
+++ b/ext/B/B/Terse.pm
@@ -1,7 +1,10 @@
 package B::Terse;
+
+our $VERSION = '1.00';
+
 use strict;
-use B qw(peekop class walkoptree_slow walkoptree_exec
-        main_start main_root cstring svref_2object);
+use B qw(peekop class walkoptree walkoptree_exec walkoptree_slow
+        main_start main_root cstring svref_2object SVf_IVisUV);
 use B::Asmdata qw(@specialsv_name);
 
 sub terse {
@@ -15,8 +18,9 @@ sub terse {
 }
 
 sub compile {
-    my $order = shift;
+    my $order = @_ ? shift : "";
     my @options = @_;
+    B::clearsym();
     if (@options) {
        return sub {
            my $objname;
@@ -36,7 +40,7 @@ sub compile {
 }
 
 sub indent {
-    my $level = shift;
+    my $level = @_ ? shift : 0;
     return "    " x $level;
 }
 
@@ -53,10 +57,9 @@ sub B::SVOP::terse {
     $op->sv->terse(0);
 }
 
-sub B::GVOP::terse {
+sub B::PADOP::terse {
     my ($op, $level) = @_;
-    print indent($level), peekop($op), "  ";
-    $op->gv->terse(0);
+    print indent($level), peekop($op), "  ", $op->padix, "\n";
 }
 
 sub B::PMOP::terse {
@@ -78,7 +81,7 @@ sub B::COP::terse {
     if ($label) {
        $label = " label ".cstring($label);
     }
-    print indent($level), peekop($op), $label, "\n";
+    print indent($level), peekop($op), $label || "", "\n";
 }
 
 sub B::PV::terse {
@@ -102,13 +105,14 @@ sub B::GV::terse {
        $stash = $stash . "::";
     }
     print indent($level);
-    printf "%s (0x%lx) *%s%s\n", class($gv), $$gv, $stash, $gv->NAME;
+    printf "%s (0x%lx) *%s%s\n", class($gv), $$gv, $stash, $gv->SAFENAME;
 }
 
 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 {
@@ -117,6 +121,27 @@ sub B::NV::terse {
     printf "%s (0x%lx) %s\n", class($sv), $$sv, $sv->NV;
 }
 
+sub B::RV::terse {
+    my ($rv, $level) = @_;
+    print indent($level);
+    printf "%s (0x%lx) %s\n", class($rv), $$rv, printref($rv);
+}
+
+sub printref {
+    my $rv = shift;
+    my $rcl = class($rv->RV);
+    if ($rcl eq 'PV') {
+       return "\\" . cstring($rv->RV->$rcl);
+    } elsif ($rcl eq 'NV') {
+       return "\\" . $rv->RV->$rcl;
+    } elsif ($rcl eq 'IV') {
+       return sprintf "\\%" . ($rv->RV->FLAGS & SVf_IVisUV ? "u" : "d"),
+           $rv->RV->int_value;
+    } elsif ($rcl eq 'RV') {
+       return "\\" . printref($rv->RV);
+    }
+}
+
 sub B::NULL::terse {
     my ($sv, $level) = @_;
     print indent($level);
@@ -130,3 +155,23 @@ sub B::SPECIAL::terse {
 }
 
 1;
+
+__END__
+
+=head1 NAME
+
+B::Terse - Walk Perl syntax tree, printing terse info about ops
+
+=head1 SYNOPSIS
+
+       perl -MO=Terse[,OPTIONS] foo.pl
+
+=head1 DESCRIPTION
+
+See F<ext/B/README>.
+
+=head1 AUTHOR
+
+Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+
+=cut