summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2014-11-07 23:34:11 -0800
committerFather Chrysostomos <sprout@cpan.org>2014-11-08 00:33:02 -0800
commit12cea2fa656447eef8848bac6de2e3fe413eb787 (patch)
tree8c937d687508da83ee5c153fe2d42ff558b1114b /lib
parent9e209402444aedd210f045f2557e631ca974dda2 (diff)
downloadperl-12cea2fa656447eef8848bac6de2e3fe413eb787.tar.gz
Fix Deparse OPpLVAL_INTRO handling in lists
The renumbering of private flags a few commits ago caused an exist- ing Deparse bug to occur more often. It was assuming that the OPpLVAL_INTRO and OPpOUR_INTRO flags could occur on any ops for which it did not have explicit exceptions. This commit changes it to check for only those ops known to use those flags, thus fixing bug #119815.
Diffstat (limited to 'lib')
-rw-r--r--lib/B/Deparse.pm47
-rw-r--r--lib/B/Deparse.t3
2 files changed, 28 insertions, 22 deletions
diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
index ef22e060ea..47ca02cf11 100644
--- a/lib/B/Deparse.pm
+++ b/lib/B/Deparse.pm
@@ -3057,6 +3057,21 @@ sub pp_grepwhile { mapop(@_, "grep") }
sub pp_mapstart { baseop(@_, "map") }
sub pp_grepstart { baseop(@_, "grep") }
+my %uses_intro;
+BEGIN {
+ @uses_intro{
+ eval { require B::Op_private }
+ ? grep +($B::Op_private::bits{$_}{log(OPpLVAL_INTRO) / log 2}
+ ||'')
+ eq 'OPpLVAL_INTRO',
+ keys %B::Op_private::bits
+ : qw(gvsv rv2sv rv2hv rv2gv rv2av aelem helem aslice
+ hslice delete padsv padav padhv enteriter entersub padrange
+ pushmark cond_expr refassign list)
+ } = ();
+ delete @uses_intro{qw( lvref lvrefslice lvavref )};
+}
+
sub pp_list {
my $self = shift;
my($op, $cx) = @_;
@@ -3067,27 +3082,10 @@ sub pp_list {
my $local = "either"; # could be local(...), my(...), state(...) or our(...)
my $type;
for ($lop = $kid; !null($lop); $lop = $lop->sibling) {
- # This assumes that no other private flags equal 128, and that
- # OPs that store things other than flags in their op_private,
- # like OP_AELEMFAST, won't be immediate children of a list.
- #
- # OP_ENTERSUB and OP_SPLIT can break this logic, so check for them.
- # I suspect that open and exit can too.
- # XXX This really needs to be rewritten to accept only those ops
- # known to take the OPpLVAL_INTRO flag.
-
my $lopname = $lop->name;
my $loppriv = $lop->private;
- if (!($loppriv & (OPpLVAL_INTRO|OPpOUR_INTRO)
- or $lopname eq "undef")
- or $lopname =~ /^(?:entersub|exit|open|split
- |lv(?:av)?ref(?:slice)?)\z/x)
- {
- $local = ""; # or not
- last;
- }
my $newtype;
- if ($lopname =~ /^pad[ash]v$/) {
+ if ($lopname =~ /^pad[ash]v$/ && $loppriv & OPpLVAL_INTRO) {
if ($loppriv & OPpPAD_STATE) { # state()
($local = "", last) if $local !~ /^(?:either|state)$/;
$local = "state";
@@ -3113,10 +3111,15 @@ sub pp_list {
)) {
$newtype = $t;
}
- } elsif ($lopname ne "undef"
- # specifically avoid the "reverse sort" optimisation,
- # where "reverse" is nullified
- && !($lopname eq 'sort' && ($lop->flags & OPpSORT_REVERSE)))
+ } elsif ($lopname ne 'undef'
+ and !($loppriv & OPpLVAL_INTRO)
+ || !exists $uses_intro{$lopname eq 'null'
+ ? substr B::ppname($lop->targ), 3
+ : $lopname})
+ {
+ $local = ""; # or not
+ last;
+ } elsif ($lopname ne "undef")
{
# local()
($local = "", last) if $local !~ /^(?:either|local)$/;
diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t
index 6b2799e46e..d05e3afe1f 100644
--- a/lib/B/Deparse.t
+++ b/lib/B/Deparse.t
@@ -1103,6 +1103,9 @@ s/foo/\(3);/eg;
# y///r
tr/a/b/r;
####
+# y///d in list [perl #119815]
+() = tr/a//d;
+####
# [perl #90898]
<a,>;
####