Increase $B::Deparse::VERSION to 1.10

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

diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm
index abe18a8..68f8ffc 100644 (file)
--- a/dist/B-Deparse/Deparse.pm
+++ b/dist/B-Deparse/Deparse.pm
@@ -26,15 +26,9 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
         ($] < 5.009 ? 'PMf_SKIPWHITE' : qw(RXf_SKIPWHITE)),
         ($] < 5.011 ? 'CVf_LOCKED' : 'OPpREVERSE_INPLACE'),
         ($] < 5.013 ? () : 'PMf_NONDESTRUCT'),
-        ($] < 5.015003 &&
-            # This empirical feature test is required during the
-            # transitional phase where blead still identifies itself
-            # as 5.15.2 but has had $[ removed.  After blead has its
-            # version number bumped to 5.15.3, this can be reduced to
-            # just test $] < 5.015003.
-            ($] < 5.015002 || do { require B; exists(&B::OPpCONST_ARYBASE) })
-            ? qw(OPpCONST_ARYBASE) : ());
-$VERSION = "1.08";
+        ($] < 5.015003 ? qw(OPpCONST_ARYBASE) : ()),
+        ($] < 5.015005 ? () : qw(OPpEVAL_BYTES));
+$VERSION = "1.10";
 use strict;
 use vars qw/$AUTOLOAD/;
 use warnings ();
@@ -44,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 OPpCONST_ARYBASE)) {
+               PMf_NONDESTRUCT OPpCONST_ARYBASE OPpEVAL_BYTES)) {
        no strict 'refs';
        *{$_} = sub () {0} unless *{$_}{CODE};
     }
@@ -1297,10 +1291,16 @@ sub stash_variable {
        return "$prefix$name";
     }
 
-    if (defined $cx && $cx == 26) {
-       if ($prefix eq '@' && $name =~ /^[^\w+-]$/) {
+    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;
@@ -1551,6 +1551,7 @@ my %feature_keywords = (
     when    => 'switch',
     default => 'switch',
     break   => 'switch',
+    evalbytes=>'evalbytes',
 );
 
 sub keyword {
@@ -1558,14 +1559,12 @@ sub keyword {
     my $name = shift;
     return $name if $name =~ /^CORE::/; # just in case
     if (exists $feature_keywords{$name}) {
-       return
-         $self->{'hinthash'}
-          && $self->{'hinthash'}{"feature_$feature_keywords{$name}"}
-           ? $name
-           : "CORE::$name";
+       return "CORE::$name"
+        if !$self->{'hinthash'}
+        || !$self->{'hinthash'}{"feature_$feature_keywords{$name}"}
     }
     if (
-      $name !~ /^(?:chom?p|exec|s(?:elect|ystem))\z/
+      $name !~ /^(?:chom?p|do|exec|glob|s(?:elect|ystem))\z/
        && !defined eval{prototype "CORE::$name"}
     ) { return $name }
     if (
@@ -1760,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") }
@@ -2462,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 . '>';
     }
@@ -2501,7 +2508,7 @@ sub indirop {
     my $self = shift;
     my($op, $cx, $name) = @_;
     my($expr, @exprs);
-    my $kid = $op->first->sibling;
+    my $firstkid = my $kid = $op->first->sibling;
     my $indir = "";
     if ($op->flags & OPf_STACKED) {
        $indir = $kid;
@@ -2525,7 +2532,7 @@ sub indirop {
        $indir = '{$b cmp $a} ';
     }
     for (; !null($kid); $kid = $kid->sibling) {
-       $expr = $self->deparse($kid, 6);
+       $expr = $self->deparse($kid, !$indir && $kid == $firstkid && $name eq "sort" && $firstkid->name eq "entersub" ? 16 : 6);
        push @exprs, $expr;
     }
     my $name2;
@@ -2538,7 +2545,7 @@ sub indirop {
     }
 
     my $args = $indir . join(", ", @exprs);
-    if ($indir ne "" and $name eq "sort") {
+    if ($indir ne "" && $name eq "sort") {
        # We don't want to say "sort(f 1, 2, 3)", since perl -w will
        # give bareword warnings in that case. Therefore if context
        # requires, we'll put parens around the outside "(sort f 1, 2,
@@ -2550,6 +2557,13 @@ sub indirop {
        } else {
            return "$name2 $args";
        }
+    } elsif (
+       !$indir && $name eq "sort"
+      && $op->first->sibling->name eq 'entersub'
+    ) {
+       # We cannot say sort foo(bar), as foo will be interpreted as a
+       # comparison routine.  We have to say sort(...) in that case.
+       return "$name2($args)";
     } else {
        return $self->maybe_parens_func($name2, $args, $cx, 5);
     }
@@ -2591,6 +2605,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) {