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)
{
if (gimme == G_SCALAR) {
if (CxLVAL(cx) && !ref) { /* Leave it as it is if we can. */
SV *sv;
+ const char *what = NULL;
if (MARK < SP) {
assert(MARK+1 == SP);
if ((SvPADTMP(TOPs) ||
== SVf_READONLY
) &&
!SvSMAGICAL(TOPs)) {
- LEAVE;
- cxstack_ix--;
- POPSUB(cx,sv);
- PL_curpm = newpm;
- LEAVESUB(sv);
- Perl_croak(aTHX_
- "Can't return %s from lvalue subroutine",
+ what =
SvREADONLY(TOPs) ? (TOPs == &PL_sv_undef) ? "undef"
- : "a readonly value" : "a temporary");
- }
- else { /* Can be a localized value
- EXTEND_MORTAL(1); * subject to deletion. */
- PL_tmps_stack[++PL_tmps_ix] = *SP;
- SvREFCNT_inc_void(*SP);
- *++newsp = *SP;
+ : "a readonly value" : "a temporary";
}
+ else goto copy_sv;
}
else {
/* sub:lvalue{} will take us here. */
- LEAVE;
- cxstack_ix--;
- POPSUB(cx,sv);
- PL_curpm = newpm;
- LEAVESUB(sv);
- Perl_croak(aTHX_
- /* diag_listed_as: Can't return %s from lvalue subroutine*/
- "Can't return undef from lvalue subroutine"
- );
+ what = "undef";
}
+ LEAVE;
+ cxstack_ix--;
+ POPSUB(cx,sv);
+ PL_curpm = newpm;
+ LEAVESUB(sv);
+ Perl_croak(aTHX_
+ "Can't return %s from lvalue subroutine", what
+ );
}
- else if (MARK < SP) {
+ if (MARK < SP) {
+ copy_sv:
if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) {
*++newsp = SvREFCNT_inc(*SP);
FREETMPS;