#define PUSHSUB(cx) \
+ { \
+ /* If the context is indeterminate, then only the lvalue */ \
+ /* flags that the caller also has are applicable. */ \
+ U8 phlags = \
+ (PL_op->op_flags & OPf_WANT) \
+ ? OPpENTERSUB_LVAL_MASK \
+ : !(PL_op->op_private & OPpENTERSUB_LVAL_MASK) \
+ ? 0 : was_lvalue_sub(); \
PUSHSUB_BASE(cx) \
cx->blk_u16 = PL_op->op_private & \
- (OPpLVAL_INTRO|OPpENTERSUB_INARGS|OPpENTERSUB_DEREF);
+ (phlags|OPpENTERSUB_DEREF); \
+ }
/* variant for use by OP_DBSTATE, where op_private holds hint bits */
#define PUSHSUB_DB(cx) \
: Used in perly.y
pR |OP* |invert |NULLOK OP* cmd
ApR |I32 |is_lvalue_sub
+: Used in cop.h
+pR |I32 |was_lvalue_sub
ApPR |U32 |to_uni_upper_lc|U32 c
ApPR |U32 |to_uni_title_lc|U32 c
ApPR |U32 |to_uni_lower_lc|U32 c
#define unshare_hek(a) Perl_unshare_hek(aTHX_ a)
#define vivify_ref(a,b) Perl_vivify_ref(aTHX_ a,b)
#define wait4pid(a,b,c) Perl_wait4pid(aTHX_ a,b,c)
+#define was_lvalue_sub() Perl_was_lvalue_sub(aTHX)
#define watch(a) Perl_watch(aTHX_ a)
#define write_to_stderr(a) Perl_write_to_stderr(aTHX_ a)
#define yyerror(a) Perl_yyerror(aTHX_ a)
else if (o->op_private & OPpENTERSUB_NOMOD)
return o;
else { /* lvalue subroutine call */
- o->op_private |= OPpLVAL_INTRO;
+ o->op_private |= OPpLVAL_INTRO
+ |(OPpENTERSUB_INARGS * (type == OP_LEAVESUBLV));
PL_modcount = RETURN_UNLIMITED_NUMBER;
if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN) {
/* Backward compatibility mode: */
#define OPpDEREF_SV (32|64) /* Want ref to SV. */
/* Private for OP_RV2SV, OP_RV2AV, OP_RV2AV */
#define OPpDEREFed 4 /* prev op was OPpDEREF */
+
/* OP_ENTERSUB only */
#define OPpENTERSUB_DB 16 /* Debug subroutine. */
#define OPpENTERSUB_HASTARG 32 /* Called from OP tree. */
#define OPpENTERSUB_NOMOD 64 /* Immune to op_lvalue() for :attrlist. */
#define OPpENTERSUB_INARGS 4 /* Lval used as arg to a sub. */
#define OPpENTERSUB_DEREF 1 /* Lval call that autovivifies. */
+ /* Mask for OP_ENTERSUB flags, the absence of which must be propagated
+ in dynamic context */
+#define OPpENTERSUB_LVAL_MASK (OPpLVAL_INTRO|OPpENTERSUB_INARGS)
+
/* OP_RV2CV only */
#define OPpENTERSUB_AMPER 8 /* Used & form to call. */
#define OPpENTERSUB_NOPAREN 128 /* bare sub call (without parens) */
dying, as they are indistinguishable syntactically from nullary functions
like C<time>.
+=item *
+
+A bug affecting lvalue context propagation through nested lvalue subroutine
+calls has been fixed. Previously, returning a value in nested rvalue
+context would be treated as lvalue context by the inner subroutine call,
+resulting in some values (such as read-only values) being rejected.
+
=back
=head1 Known Problems
return 0;
}
+/* only used by PUSHSUB */
+I32
+Perl_was_lvalue_sub(pTHX)
+{
+ dVAR;
+ const I32 cxix = dopoptosub(cxstack_ix-1);
+ assert(cxix >= 0); /* We should only be called from inside subs */
+
+ if (CxLVAL(cxstack + cxix) && CvLVALUE(cxstack[cxix].blk_sub.cv))
+ return CxLVAL(cxstack + cxix);
+ else
+ return 0;
+}
+
STATIC I32
S_dopoptosub_at(pTHX_ const PERL_CONTEXT *cxstk, I32 startingblock)
{
#define PERL_ARGS_ASSERT_WARNER \
assert(pat)
+PERL_CALLCONV I32 Perl_was_lvalue_sub(pTHX)
+ __attribute__warn_unused_result__;
+
PERL_CALLCONV void Perl_watch(pTHX_ char** addr)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_WATCH \
@INC = '../lib';
require './test.pl';
}
-plan tests=>175;
+plan tests=>179;
sub a : lvalue { my $a = 34; ${\(bless \$a)} } # Return a temporary
sub b : lvalue { ${\shift} }
.$suffix # (they used to be copied)
}
continue { $suffix = ' (explicit return)' }
+
+# Returning unwritables from nested lvalue sub call in in rvalue context
+# First, ensure we are testing what we think we are:
+if (!Internals::SvREADONLY($])) { Internals::SvREADONLY($],1); }
+sub squibble : lvalue { return $] }
+sub squebble : lvalue { squibble }
+sub squabble : lvalue { return squibble }
+is $x = squebble, $], 'returning ro from nested lv sub call in rv cx';
+is $x = squabble, $], 'explct. returning ro from nested lv sub in rv cx';
+is \squebble, \$], 'returning ro from nested lv sub call in ref cx';
+is \squabble, \$], 'explct. returning ro from nested lv sub in ref cx';