Make constant promotion null-clean

[perl5.git] / dist / B-Deparse / Deparse.pm

diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm
index e3079ad..cb54b95 100644 (file)
--- a/dist/B-Deparse/Deparse.pm
+++ b/dist/B-Deparse/Deparse.pm
@@ -14,7 +14,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
         OPf_KIDS OPf_REF OPf_STACKED OPf_SPECIAL OPf_MOD
         OPpLVAL_INTRO OPpOUR_INTRO OPpENTERSUB_AMPER OPpSLICE OPpCONST_BARE
         OPpTRANS_SQUASH OPpTRANS_DELETE OPpTRANS_COMPLEMENT OPpTARGET_MY
-        OPpCONST_ARYBASE OPpEXISTS_SUB OPpSORT_NUMERIC OPpSORT_INTEGER
+        OPpEXISTS_SUB OPpSORT_NUMERIC OPpSORT_INTEGER
         OPpSORT_REVERSE
         SVf_IOK SVf_NOK SVf_ROK SVf_POK SVpad_OUR SVf_FAKE SVs_RMG SVs_SMG
          CVf_METHOD CVf_LVALUE
@@ -25,8 +25,10 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
         ($] < 5.008009 ? () : qw(OPpCONST_NOVER OPpPAD_STATE)),
         ($] < 5.009 ? 'PMf_SKIPWHITE' : qw(RXf_SKIPWHITE)),
         ($] < 5.011 ? 'CVf_LOCKED' : 'OPpREVERSE_INPLACE'),
-        ($] < 5.013 ? () : 'PMf_NONDESTRUCT');
-$VERSION = "1.05";
+        ($] < 5.013 ? () : 'PMf_NONDESTRUCT'),
+        ($] < 5.015003 ? qw(OPpCONST_ARYBASE) : ()),
+        ($] < 5.015005 ? () : qw(OPpEVAL_BYTES));
+$VERSION = "1.09";
 use strict;
 use vars qw/$AUTOLOAD/;
 use warnings ();
@@ -36,7 +38,7 @@ BEGIN {
     # be to fake up a dummy constant that will never actually be true.
     foreach (qw(OPpSORT_INPLACE OPpSORT_DESCEND OPpITER_REVERSED OPpCONST_NOVER
                OPpPAD_STATE RXf_SKIPWHITE CVf_LOCKED OPpREVERSE_INPLACE
-               PMf_NONDESTRUCT)) {
+               PMf_NONDESTRUCT OPpCONST_ARYBASE OPpEVAL_BYTES)) {
        no strict 'refs';
        *{$_} = sub () {0} unless *{$_}{CODE};
     }
@@ -737,7 +739,11 @@ sub ambient_pragmas {
        }
 
        elsif ($name eq '$[') {
-           $arybase = $val;
+           if (OPpCONST_ARYBASE) {
+               $arybase = $val;
+           } else {
+               croak "\$[ can't be non-zero on this perl" unless $val == 0;
+           }
        }
 
        elsif ($name eq 'integer'
@@ -1095,7 +1101,9 @@ sub maybe_my {
     my $self = shift;
     my($op, $cx, $text) = @_;
     if ($op->private & OPpLVAL_INTRO and not $self->{'avoid_local'}{$$op}) {
-       my $my = $op->private & OPpPAD_STATE ? "state" : "my";
+       my $my = $op->private & OPpPAD_STATE
+           ? $self->keyword("state")
+           : "my";
        if (want_scalar($op)) {
            return "$my $text";
        } else {
@@ -1274,7 +1282,7 @@ Carp::confess() unless ref($gv) eq "B::GV";
 # If a lexical with the same name is in scope, it may need to be
 # fully-qualified.
 sub stash_variable {
-    my ($self, $prefix, $name) = @_;
+    my ($self, $prefix, $name, $cx) = @_;
 
     return "$prefix$name" if $name =~ /::/;
 
@@ -1283,6 +1291,18 @@ sub stash_variable {
        return "$prefix$name";
     }
 
+    if ($name =~ /^[^\w+-]$/) {
+      if (defined $cx && $cx == 26) {
+       if ($prefix eq '@') {
+           return "$prefix\{$name}";
+       }
+       elsif ($name eq '#') { return '${#}' } #  "${#}a" vs "$#a"
+      }
+      if ($prefix eq '$#') {
+       return "\$#{$name}";
+      }
+    }
+
     my $v = ($prefix eq '$#' ? '@' : $prefix) . $name;
     return $prefix .$self->{'curstash'}.'::'. $name if $self->lex_in_scope($v);
     return "$prefix$name";
@@ -1404,7 +1424,7 @@ sub pp_nextstate {
        $self->{'curstash'} = $stash;
     }
 
-    if ($self->{'arybase'} != $op->arybase) {
+    if (OPpCONST_ARYBASE && $self->{'arybase'} != $op->arybase) {
        push @text, '$[ = '. $op->arybase .";\n";
        $self->{'arybase'} = $op->arybase;
     }
@@ -1523,12 +1543,28 @@ sub pp_setstate { pp_nextstate(@_) }
 
 sub pp_unstack { return "" } # see also leaveloop
 
+my %feature_keywords = (
+  # keyword => 'feature',
+    state   => 'state',
+    say     => 'say',
+    given   => 'switch',
+    when    => 'switch',
+    default => 'switch',
+    break   => 'switch',
+    evalbytes=>'evalbytes',
+);
+
 sub keyword {
     my $self = shift;
     my $name = shift;
     return $name if $name =~ /^CORE::/; # just in case
+    if (exists $feature_keywords{$name}) {
+       return "CORE::$name"
+        if !$self->{'hinthash'}
+        || !$self->{'hinthash'}{"feature_$feature_keywords{$name}"}
+    }
     if (
-      $name !~ /^(?:chom?p|exec|system)\z/
+      $name !~ /^(?:chom?p|do|exec|glob|s(?:elect|ystem))\z/
        && !defined eval{prototype "CORE::$name"}
     ) { return $name }
     if (
@@ -1723,7 +1759,12 @@ sub pp_alarm { unop(@_, "alarm") }
 sub pp_sleep { maybe_targmy(@_, \&unop, "sleep") }
 
 sub pp_dofile { unop(@_, "do") }
-sub pp_entereval { unop(@_, "eval") }
+sub pp_entereval {
+    unop(
+      @_,
+      $_[1]->private & OPpEVAL_BYTES ? $_[0]->keyword('evalbytes') : "eval"
+    )
+}
 
 sub pp_ghbyname { unop(@_, "gethostbyname") }
 sub pp_gnbyname { unop(@_, "getnetbyname") }
@@ -1740,11 +1781,7 @@ sub pp_ggrgid { unop(@_, "getgrgid") }
 sub pp_lock { unop(@_, "lock") }
 
 sub pp_continue { unop(@_, "continue"); }
-sub pp_break {
-    my ($self, $op) = @_;
-    return "" if $op->flags & OPf_SPECIAL;
-    unop(@_, "break");
-}
+sub pp_break { unop(@_, "break"); }
 
 sub givwhen {
     my $self = shift;
@@ -1753,7 +1790,7 @@ sub givwhen {
     my $enterop = $op->first;
     my ($head, $block);
     if ($enterop->flags & OPf_SPECIAL) {
-       $head = "default";
+       $head = $self->keyword("default");
        $block = $self->deparse($enterop->first, 0);
     }
     else {
@@ -1768,8 +1805,8 @@ sub givwhen {
        "\b}\cK";
 }
 
-sub pp_leavegiven { givwhen(@_, "given"); }
-sub pp_leavewhen  { givwhen(@_, "when"); }
+sub pp_leavegiven { givwhen(@_, $_[0]->keyword("given")); }
+sub pp_leavewhen  { givwhen(@_, $_[0]->keyword("when")); }
 
 sub pp_exists {
     my $self = shift;
@@ -2429,9 +2466,12 @@ sub pp_glob {
     my $self = shift;
     my($op, $cx) = @_;
     my $text = $self->dq($op->first->sibling);  # skip pushmark
+    my $keyword =
+       $op->flags & OPf_SPECIAL ? 'glob' : $self->keyword('glob');
     if ($text =~ /^\$?(\w|::|\`)+$/ # could look like a readline
-       or $text =~ /[<>]/) {
-       return 'glob(' . single_delim('qq', '"', $text) . ')';
+       or $keyword =~ /^CORE::/
+        or $text =~ /[<>]/) {
+       return "$keyword(" . single_delim('qq', '"', $text) . ')';
     } else {
        return '<' . $text . '>';
     }
@@ -2558,6 +2598,7 @@ sub pp_list {
     my($op, $cx) = @_;
     my($expr, @exprs);
     my $kid = $op->first->sibling; # skip pushmark
+    return '' if class($kid) eq 'NULL';
     my $lop;
     my $local = "either"; # could be local(...), my(...), state(...) or our(...)
     for ($lop = $kid; !null($lop); $lop = $lop->sibling) {
@@ -2907,7 +2948,7 @@ sub pp_gvsv {
     my($op, $cx) = @_;
     my $gv = $self->gv_or_padgv($op);
     return $self->maybe_local($op, $cx, $self->stash_variable("\$",
-                                $self->gv_name($gv)));
+                                $self->gv_name($gv), $cx));
 }
 
 sub pp_gv {
@@ -2917,22 +2958,25 @@ sub pp_gv {
     return $self->gv_name($gv);
 }
 
+sub pp_aelemfast_lex {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $name = $self->padname($op->targ);
+    $name =~ s/^@/\$/;
+    return $name . "[" .  ($op->private + $self->{'arybase'}) . "]";
+}
+
 sub pp_aelemfast {
     my $self = shift;
     my($op, $cx) = @_;
-    my $name;
-    if ($op->flags & OPf_SPECIAL) { # optimised PADAV
-       $name = $self->padname($op->targ);
-       $name =~ s/^@/\$/;
-    }
-    else {
-       my $gv = $self->gv_or_padgv($op);
-       $name = $self->gv_name($gv);
-       $name = $self->{'curstash'}."::$name"
-           if $name !~ /::/ && $self->lex_in_scope('@'.$name);
-       $name = '$' . $name;
-    }
+    # optimised PADAV, pre 5.15
+    return $self->pp_aelemfast_lex(@_) if ($op->flags & OPf_SPECIAL);
 
+    my $gv = $self->gv_or_padgv($op);
+    my $name = $self->gv_name($gv);
+    $name = $self->{'curstash'}."::$name"
+       if $name !~ /::/ && $self->lex_in_scope('@'.$name);
+    $name = '$' . $name;
     return $name . "[" .  ($op->private + $self->{'arybase'}) . "]";
 }
 
@@ -2946,7 +2990,7 @@ sub rv2x {
     }
     my $kid = $op->first;
     if ($kid->name eq "gv") {
-       return $self->stash_variable($type, $self->deparse($kid, 0));
+       return $self->stash_variable($type, $self->deparse($kid, 0), $cx);
     } elsif (is_scalar $kid) {
        my $str = $self->deparse($kid, 0);
        if ($str =~ /^\$([^\w\d])\z/) {
@@ -4334,7 +4378,7 @@ sub pp_split {
     } elsif (!ref($replroot) and $replroot > 0) {
        $gv = $self->padval($replroot);
     }
-    $ary = $self->stash_variable('@', $self->gv_name($gv)) if $gv;
+    $ary = $self->stash_variable('@', $self->gv_name($gv), $cx) if $gv;
 
     for (; !null($kid); $kid = $kid->sibling) {
        push @exprs, $self->deparse($kid, 6);
@@ -4762,6 +4806,7 @@ expect.
 =item $[
 
 Takes a number, the value of the array base $[.
+Cannot be non-zero on Perl 5.15.3 or later.
 
 =item bytes