Fix bare blocks in lvalue subs

If a bare block is the last thing in an lvalue sub, OP_LEAVELOOP needs
to propagate lvalue context and handle returned arrays properly, just
as OP_LEAVE has done since yesterday.

This is a follow-up to 2ec7f6f24289.  This came up in ticket #119797.

diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index 2116932..40713aa 100644 (file)
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -598,7 +598,7 @@ $priv{$_}{128} = "LVINTRO"
          aelem helem aslice hslice padsv padav padhv enteriter entersub
          padrange pushmark);
 $priv{$_}{64} = "REFC" for qw(leave leavesub leavesublv leavewrite);
-$priv{leave}{128} = "LV";
+$priv{$_}{128} = "LV" for qw(leave leaveloop);
 @{$priv{aassign}}{32,64} = qw(STATE COMMON);
 @{$priv{sassign}}{32,64,128} = qw(STATE BKWARD CV2GV);
 $priv{$_}{64} = "RTIME" for qw(match subst substcont qr);

diff --git a/op.c b/op.c
index 942b4d6..7dcaa3d 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2253,6 +2253,7 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
        break;
 
     case OP_LEAVE:
+    case OP_LEAVELOOP:
        o->op_private |= OPpLVALUE;
     case OP_SCOPE:
     case OP_ENTER:

diff --git a/op.h b/op.h
index 3670caf..1c59ca8 100644 (file)
--- a/op.h
+++ b/op.h
@@ -172,7 +172,7 @@ Deprecated.  Use C<GIMME_V> instead.
 /* Private for OP_LEAVE, OP_LEAVESUB, OP_LEAVESUBLV and OP_LEAVEWRITE */
 #define OPpREFCOUNTED          64      /* op_targ carries a refcount */
 
-/* Private for OP_LEAVE only */
+/* Private for OP_LEAVE and OP_LEAVELOOP */
 #define OPpLVALUE              128     /* Do not copy return value */
 
 /* Private for OP_AASSIGN */

diff --git a/pp_ctl.c b/pp_ctl.c
index 4be2b19..c3b66bb 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2277,7 +2277,8 @@ PP(pp_leaveloop)
     newsp = PL_stack_base + cx->blk_loop.resetsp;
 
     TAINT_NOT;
-    SP = adjust_stack_on_leave(newsp, SP, MARK, gimme, 0, FALSE);
+    SP = adjust_stack_on_leave(newsp, SP, MARK, gimme, 0,
+                              PL_op->op_private & OPpLVALUE);
     PUTBACK;
 
     POPLOOP(cx);       /* Stack values are safe: release loop vars ... */

diff --git a/t/op/sub_lval.t b/t/op/sub_lval.t
index acc9ecb..357c8a4 100644 (file)
--- a/t/op/sub_lval.t
+++ b/t/op/sub_lval.t
@@ -3,7 +3,7 @@ BEGIN {
     @INC = '../lib';
     require './test.pl';
 }
-plan tests=>201;
+plan tests=>203;
 
 sub a : lvalue { my $a = 34; ${\(bless \$a)} }  # Return a temporary
 sub b : lvalue { ${\shift} }
@@ -1008,3 +1008,12 @@ sub unless119797 : lvalue {
 eval { (unless119797(0)) = 4..6 };
 is $@, "", '$@ after writing to array returned by unless';
 is "@119797", "4 5 6", 'writing to array returned by unless';
+sub bare119797 : lvalue {
+    {;
+       @119797
+    }
+}
+@119797 = ();
+eval { (bare119797(0)) = 4..6 };
+is $@, "", '$@ after writing to array returned by bare block';
+is "@119797", "4 5 6", 'writing to array returned by bare block';