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.

diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
index 3dbcdfa..e9b9a99 100644 (file)
--- 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 (file)
--- 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",