Change ValidProtoString() to valid_proto_string()

[perl5.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 5fd7bf5..854c89d 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1469,6 +1469,20 @@ Perl_is_lvalue_sub(pTHX)
        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)
 {
@@ -2296,6 +2310,7 @@ S_return_lvalues(pTHX_ SV **mark, SV **sp, SV **newsp, I32 gimme,
     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) ||
@@ -2303,30 +2318,24 @@ S_return_lvalues(pTHX_ SV **mark, SV **sp, SV **newsp, I32 gimme,
                       == 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");
+                       : "a readonly value" : "a temporary";
                }
-               goto copy_sv;
+               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
+           );
        }
        if (MARK < SP) {
              copy_sv: