In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/5e965771417d0c5da2ee767d610c735b6e1267e0?hp=28f6df06be723914dc766be45e49f66ef35d783c>
- Log ----------------------------------------------------------------- commit 5e965771417d0c5da2ee767d610c735b6e1267e0 Author: Father Chrysostomos <[email protected]> Date: Tue Dec 23 22:34:10 2014 -0800 Deparse: Donât choke on SPECIAL constants Some modules, e.g., POSIX, create constants in the form of references to immortals in the stash. B::Deparse started croaking on these in v5.21.6-584-g03b8f76. $ ./perl -Ilib -MO=Deparse -MPOSIX -e0 Can't locate object method "FLAGS" via package "B::SPECIAL" at lib/B/Deparse.pm line 745. CHECK failed--call queue aborted. At the same time I fixed the stash-probing code, I also had to fix deparsing of \!0, which had the same bug. ----------------------------------------------------------------------- Summary of changes: lib/B/Deparse.pm | 11 ++++++----- lib/B/Deparse.t | 7 ++++++- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm index 3dbcdfa..e9b9a99 100644 --- a/lib/B/Deparse.pm +++ b/lib/B/Deparse.pm @@ -743,7 +743,7 @@ sub stash_subs { if ($class eq "CV") { $self->todo($referent, 0); } elsif ( - $class !~ /^(AV|HV|CV|FM|IO)\z/ + $class !~ /^(AV|HV|CV|FM|IO|SPECIAL)\z/ # A more robust way to write that would be this, but B does # not provide the SVt_ constants: # ($referent->FLAGS & B::SVTYPEMASK) < B::SVt_PVAV @@ -4795,16 +4795,17 @@ sub const { return $str; } elsif ($sv->FLAGS & SVf_ROK && $sv->can("RV")) { my $ref = $sv->RV; - if (class($ref) eq "AV") { + my $class = class($ref); + if ($class eq "AV") { return "[" . $self->list_const(2, $ref->ARRAY) . "]"; - } elsif (class($ref) eq "HV") { + } elsif ($class eq "HV") { my %hash = $ref->ARRAY; my @elts; for my $k (sort keys %hash) { push @elts, "$k => " . $self->const($hash{$k}, 6); } return "{" . join(", ", @elts) . "}"; - } elsif (class($ref) eq "CV") { + } elsif ($class eq "CV") { BEGIN { if ($] > 5.0150051) { require overloading; @@ -4817,7 +4818,7 @@ sub const { } return "sub " . $self->deparse_sub($ref); } - if ($ref->FLAGS & SVs_SMG) { + if ($class ne 'SPECIAL' and $ref->FLAGS & SVs_SMG) { for (my $mg = $ref->MAGIC; $mg; $mg = $mg->MOREMAGIC) { if ($mg->TYPE eq 'r') { my $re = re_uninterp(escape_re(re_unback($mg->precomp))); diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t index 3cfc9e0..d1c9f6c 100644 --- a/lib/B/Deparse.t +++ b/lib/B/Deparse.t @@ -13,7 +13,7 @@ BEGIN { use warnings; use strict; -my $tests = 44; # not counting those in the __DATA__ section +my $tests = 45; # not counting those in the __DATA__ section use B::Deparse; my $deparse = B::Deparse->new(); @@ -501,6 +501,11 @@ like runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ], qr/^sub foo \{\s+foo\(\)/m, 'recursive sub'; +is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ], + prog => 'BEGIN { $::{f}=\!0 }'), + "sub BEGIN {\n \$main::{'f'} = \\1;\n}\n", + '&PL_sv_yes constant (used to croak)'; + is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path, '-T' ], prog => '$x =~ (1?/$a/:0)'), '$x =~ ($_ =~ /$a/);'."\n", -- Perl5 Master Repository
