+STATIC void
+S_return_lvalues(pTHX_ SV **mark, SV **sp, SV **newsp, I32 gimme,
+ PERL_CONTEXT *cx, PMOP *newpm)
+{
+ const bool ref = !!(CxLVAL(cx) & OPpENTERSUB_INARGS);
+ 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) ||
+ (SvFLAGS(TOPs) & (SVf_READONLY | SVf_FAKE))
+ == SVf_READONLY
+ ) &&
+ !SvSMAGICAL(TOPs)) {
+ what =
+ SvREADONLY(TOPs) ? (TOPs == &PL_sv_undef) ? "undef"
+ : "a readonly value" : "a temporary";
+ }
+ else goto copy_sv;
+ }
+ else {
+ /* sub:lvalue{} will take us here. */
+ what = "undef";
+ }
+ LEAVE;
+ cxstack_ix--;
+ POPSUB(cx,sv);
+ PL_curpm = newpm;
+ LEAVESUB(sv);
+ Perl_croak(aTHX_
+ "Can't return %s from lvalue subroutine", what
+ );
+ }
+ if (MARK < SP) {
+ copy_sv:
+ if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) {
+ *++newsp = SvREFCNT_inc(*SP);
+ FREETMPS;
+ sv_2mortal(*newsp);
+ }
+ else
+ *++newsp =
+ !SvTEMP(*SP)
+ ? sv_2mortal(SvREFCNT_inc_simple_NN(*SP))
+ : *SP;
+ }
+ else {
+ EXTEND(newsp,1);
+ *++newsp = &PL_sv_undef;
+ }
+ if (CxLVAL(cx) & OPpENTERSUB_DEREF) {
+ SvGETMAGIC(TOPs);
+ if (!SvOK(TOPs)) {
+ U8 deref_type;
+ if (cx->blk_sub.retop->op_type == OP_RV2SV)
+ deref_type = OPpDEREF_SV;
+ else if (cx->blk_sub.retop->op_type == OP_RV2AV)
+ deref_type = OPpDEREF_AV;
+ else {
+ assert(cx->blk_sub.retop->op_type == OP_RV2HV);
+ deref_type = OPpDEREF_HV;
+ }
+ vivify_ref(TOPs, deref_type);
+ }
+ }
+ }
+ else if (gimme == G_ARRAY) {
+ assert (!(CxLVAL(cx) & OPpENTERSUB_DEREF));
+ if (ref || !CxLVAL(cx))
+ while (++MARK <= SP)
+ *++newsp =
+ SvTEMP(*MARK)
+ ? *MARK
+ : ref && SvFLAGS(*MARK) & SVs_PADTMP
+ ? sv_mortalcopy(*MARK)
+ : sv_2mortal(SvREFCNT_inc_simple_NN(*MARK));
+ else while (++MARK <= SP) {
+ if (*MARK != &PL_sv_undef
+ && (SvPADTMP(*MARK)
+ || (SvFLAGS(*MARK) & (SVf_READONLY|SVf_FAKE))
+ == SVf_READONLY
+ )
+ ) {
+ SV *sv;
+ /* Might be flattened array after $#array = */
+ PUTBACK;
+ LEAVE;
+ cxstack_ix--;
+ POPSUB(cx,sv);
+ PL_curpm = newpm;
+ LEAVESUB(sv);
+ Perl_croak(aTHX_
+ "Can't return a %s from lvalue subroutine",
+ SvREADONLY(TOPs) ? "readonly value" : "temporary");
+ }
+ else
+ *++newsp =
+ SvTEMP(*MARK)
+ ? *MARK
+ : sv_2mortal(SvREFCNT_inc_simple_NN(*MARK));
+ }
+ }
+ PL_stack_sp = newsp;
+}
+