Re: [ PATCH ] module test fest

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

diff --git a/ext/B/B.pm b/ext/B/B.pm
index 534182f..feca2e5 100644 (file)
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -6,6 +6,9 @@
 #      License or the Artistic License, as specified in the README file.
 #
 package B;
+
+our $VERSION = '1.01';
+
 use XSLoader ();
 require Exporter;
 @ISA = qw(Exporter);
@@ -15,10 +18,10 @@ require Exporter;
 @EXPORT_OK = qw(minus_c ppname save_BEGINs
                class peekop cast_I32 cstring cchar hash threadsv_names
                main_root main_start main_cv svref_2object opnumber
-               amagic_generation
+               amagic_generation perlstring
                walkoptree_slow walkoptree walkoptree_exec walksymtable
                parents comppadlist sv_undef compile_stats timing_info
-               begin_av init_av end_av);
+               begin_av init_av end_av regex_padav);
 
 sub OPf_KIDS ();
 use strict;
@@ -123,6 +126,11 @@ sub walkoptree_slow {
        }
        shift @parents;
     }
+    if (class($op) eq 'PMOP' && $op->pmreplroot && ${$op->pmreplroot}) {
+       unshift(@parents, $op);
+       walkoptree_slow($op->pmreplroot, $method, $level + 1);
+       shift @parents;
+    }
 }
 
 sub compile_stats {
@@ -208,18 +216,18 @@ sub walksymtable {
     my ($symref, $method, $recurse, $prefix) = @_;
     my $sym;
     my $ref;
-    no strict 'vars';
-    local(*glob);
+    my $fullname;
+    no strict 'refs';
     $prefix = '' unless defined $prefix;
     while (($sym, $ref) = each %$symref) {
-       *glob = "*main::".$prefix.$sym;
+        $fullname = "*main::".$prefix.$sym;
        if ($sym =~ /::$/) {
            $sym = $prefix . $sym;
            if ($sym ne "main::" && $sym ne "<none>::" && &$recurse($sym)) {
-               walksymtable(\%glob, $method, $recurse, $sym);
+               walksymtable(\%$fullname, $method, $recurse, $sym);
            }
        } else {
-           svref_2object(\*glob)->EGV->$method();
+           svref_2object(\*$fullname)->$method();
        }
     }
 }
@@ -408,6 +416,11 @@ string using the length and offset information in the struct:
 for ordinary scalars it will return the string that you'd see
 from Perl, even if it contains null characters.
 
+=item RV
+
+Same as B::RV::RV, except that it will die() if the PV isn't
+a reference.
+
 =item PVX
 
 This method is less often useful. It assumes that the string
@@ -437,6 +450,10 @@ are always stored with a null terminator, and the length field
 
 =item MOREMAGIC
 
+=item precomp
+
+Only valid on r-magic, returns the string that generated the regexp.
+
 =item PRIVATE
 
 =item TYPE
@@ -445,8 +462,15 @@ are always stored with a null terminator, and the length field
 
 =item OBJ
 
+Will die() if called on r-magic.
+
 =item PTR
 
+=item REGEX
+
+Only valid on r-magic, returns the integer value of the REGEX stored
+in the MAGIC.
+
 =back
 
 =head2 B::PVLV METHODS
@@ -562,6 +586,13 @@ If you're working with globs at runtime, and need to disambiguate
 
 =item IoFLAGS
 
+=item IsSTD
+
+Takes one arguments ( 'stdin' | 'stdout' | 'stderr' ) and returns true
+if the IoIFP of the object is equal to the handle whose name was
+passed as argument ( i.e. $io->IsSTD('stderr') is true if
+IoIFP($io) == PerlIO_stdin() ).
+
 =back
 
 =head2 B::AV METHODS
@@ -604,6 +635,8 @@ If you're working with globs at runtime, and need to disambiguate
 
 =item XSUBANY
 
+For constant subroutines, returns the constant SV returned by the subroutine.
+
 =item CvFLAGS
 
 =item const_sv
@@ -720,10 +753,16 @@ This returns the op description from the global C PL_op_desc array
 
 =item pmflags
 
+=item pmdynflags
+
 =item pmpermflags
 
 =item precomp
 
+=item pmoffet
+
+Only when perl was compiled with ithreads.
+
 =back
 
 =head2 B::SVOP METHOD
@@ -799,6 +838,14 @@ program.
 
 Returns the AV object (i.e. in class B::AV) representing INIT blocks.
 
+=item begin_av
+
+Returns the AV object (i.e. in class B::AV) representing BEGIN blocks.
+
+=item end_av
+
+Returns the AV object (i.e. in class B::AV) representing END blocks.
+
 =item main_root
 
 Returns the root op (i.e. an object in the appropriate B::OP-derived
@@ -812,6 +859,10 @@ Returns the starting op of the main part of the Perl program.
 
 Returns the AV object (i.e. in class B::AV) of the global comppadlist.
 
+=item regex_padav
+
+Only when perl was compiled with ithreads.
+
 =item sv_undef
 
 Returns the SV object corresponding to the C variable C<sv_undef>.
@@ -895,6 +946,11 @@ is only useful in a BEGIN block or else the flag is set too late.
 Returns a double-quote-surrounded escaped version of STR which can
 be used as a string in C source code.
 
+=item perlstring(STR)
+
+Returns a double-quote-surrounded escaped version of STR which can
+be used as a string in Perl source code.
+
 =item class(OBJ)
 
 Returns the class of an object without the part of the classname