# 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.
# 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
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;
}
}
-{
- 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__
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").