This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Increase $B::VERSION to 1.71
[perl5.git] / ext / B / B.pm
index d36d48b..12d8201 100644 (file)
@@ -15,7 +15,7 @@ require Exporter;
 # walkoptree comes from B.xs
 
 BEGIN {
-    $B::VERSION = '1.54';
+    $B::VERSION = '1.71';
     @B::EXPORT_OK = ();
 
     # Our BOOT code needs $VERSION set, and will append to @EXPORT_OK.
@@ -80,7 +80,8 @@ push @B::EXPORT_OK, (qw(minus_c ppname save_BEGINs
 # Nullsv *must* come first in the following so that the condition
 # ($$sv == 0) can continue to be used to test (sv == Nullsv).
 @B::specialsv_name = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no
-                       (SV*)pWARN_ALL (SV*)pWARN_NONE (SV*)pWARN_STD);
+                       (SV*)pWARN_ALL (SV*)pWARN_NONE (SV*)pWARN_STD
+                        &PL_sv_zero);
 
 {
     # Stop "-w" from complaining about the lack of a real B::OBJECT class
@@ -256,12 +257,12 @@ sub walkoptree_exec {
 sub walksymtable {
     my ($symref, $method, $recurse, $prefix) = @_;
     my $sym;
-    my $ref;
     my $fullname;
     no strict 'refs';
     $prefix = '' unless defined $prefix;
     foreach my $sym ( sort keys %$symref ) {
-        $ref= $symref->{$sym};
+        my $dummy = $symref->{$sym}; # Copying the glob and incrementing
+                                     # the GPs refcnt clears cached methods
         $fullname = "*main::".$prefix.$sym;
        if ($sym =~ /::$/) {
            $sym = $prefix . $sym;
@@ -274,72 +275,6 @@ sub walksymtable {
     }
 }
 
-{
-    package B::Section;
-    my $output_fh;
-    my %sections;
-
-    sub new {
-       my ($class, $section, $symtable, $default) = @_;
-       $output_fh ||= FileHandle->new_tmpfile;
-       my $obj = bless [-1, $section, $symtable, $default], $class;
-       $sections{$section} = $obj;
-       return $obj;
-    }
-
-    sub get {
-       my ($class, $section) = @_;
-       return $sections{$section};
-    }
-
-    sub add {
-       my $section = shift;
-       while (defined($_ = shift)) {
-           print $output_fh "$section->[1]\t$_\n";
-           $section->[0]++;
-       }
-    }
-
-    sub index {
-       my $section = shift;
-       return $section->[0];
-    }
-
-    sub name {
-       my $section = shift;
-       return $section->[1];
-    }
-
-    sub symtable {
-       my $section = shift;
-       return $section->[2];
-    }
-
-    sub default {
-       my $section = shift;
-       return $section->[3];
-    }
-
-    sub output {
-       my ($section, $fh, $format) = @_;
-       my $name = $section->name;
-       my $sym = $section->symtable || {};
-       my $default = $section->default;
-
-       seek($output_fh, 0, 0);
-       while (<$output_fh>) {
-           chomp;
-           s/^(.*?)\t//;
-           if ($1 eq $name) {
-               s{(s\\_[0-9a-f]+)} {
-                   exists($sym->{$1}) ? $sym->{$1} : $default;
-               }ge;
-               printf $fh $format, $_;
-           }
-       }
-    }
-}
-
 1;
 
 __END__
@@ -1139,6 +1074,11 @@ data structure.  See top of C<op.h> for more info.
 Returns the OP's parent. If it has no parent, or if your perl wasn't built
 with C<-DPERL_OP_PARENT>, returns NULL.
 
+Note that the global variable C<$B::OP::does_parent> is undefined on older
+perls that don't support the C<parent> method, is defined but false on
+perls that support the method but were built without  C<-DPERL_OP_PARENT>,
+and is true otherwise.
+
 =item name
 
 This returns the op name as a string (e.g. "add", "rv2av").