diff options
| author | Father Chrysostomos <sprout@cpan.org> | 2014-12-23 22:34:10 -0800 |
|---|---|---|
| committer | Father Chrysostomos <sprout@cpan.org> | 2015-02-06 12:45:24 -0800 |
| commit | 5e965771417d0c5da2ee767d610c735b6e1267e0 (patch) | |
| tree | 36b91291edf4c31c8aa01346d6de1bbae1204220 /lib | |
| parent | 28f6df06be723914dc766be45e49f66ef35d783c (diff) | |
| download | perl-5e965771417d0c5da2ee767d610c735b6e1267e0.tar.gz | |
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.
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/B/Deparse.pm | 11 | ||||
| -rw-r--r-- | 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 3dbcdfa68a..e9b9a9938b 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 3cfc9e0527..d1c9f6c30e 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", |