toke.c: In sublex_push use multi_close to detect here-doc

[perl5.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 262c930..7fd27f8 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -587,7 +587,7 @@ PP(pp_formline)
                            itembytes = len;
                        send = chophere = s + itembytes;
                        while (s < send) {
-                           if (*s & ~31)
+                           if (! isCNTRL(*s))
                                gotsome = TRUE;
                            else if (*s == '\n')
                                break;
@@ -604,7 +604,7 @@ PP(pp_formline)
                    itemsize = fieldsize;
                send = chophere = s + itemsize;
                while (s < send) {
-                   if (*s & ~31)
+                   if (! isCNTRL(*s))
                        gotsome = TRUE;
                    else if (*s == '\n')
                        break;
@@ -630,8 +630,9 @@ PP(pp_formline)
                                    chophere = s;
                                    break;
                                }
-                               if (*s++ & ~31)
+                               if (! isCNTRL(*s))
                                    gotsome = TRUE;
+                                s++;
                            }
                        }
                        else {
@@ -648,7 +649,7 @@ PP(pp_formline)
                                        break;
                                }
                                else {
-                                   if (*s & ~31)
+                                   if (! isCNTRL(*s))
                                        gotsome = TRUE;
                                    if (strchr(PL_chopset, *s))
                                        chophere = s + 1;
@@ -671,8 +672,9 @@ PP(pp_formline)
                            chophere = s;
                            break;
                        }
-                       if (*s++ & ~31)
+                       if (! isCNTRL(*s))
                            gotsome = TRUE;
+                        s++;
                    }
                }
                else {
@@ -687,7 +689,7 @@ PP(pp_formline)
                                break;
                        }
                        else {
-                           if (*s & ~31)
+                           if (! isCNTRL(*s))
                                gotsome = TRUE;
                            if (strchr(PL_chopset, *s))
                                chophere = s + 1;
@@ -829,13 +831,7 @@ PP(pp_formline)
                    U8 *send = s + to_copy;
                    while (s < send) {
                        const int ch = *s;
-                       if (trans == '~' ? (ch == '~') :
-#ifdef EBCDIC
-                              iscntrl(ch)
-#else
-                              (!(ch & ~31))
-#endif
-                       )
+                       if (trans == '~' ? (ch == '~') : isCNTRL(ch))
                            *s = ' ';
                        s++;
                    }
@@ -1815,6 +1811,7 @@ PP(pp_caller)
     const HEK *stash_hek;
     I32 count = 0;
     bool has_arg = MAXARG && TOPs;
+    const COP *lcop;
 
     if (MAXARG) {
       if (has_arg)
@@ -1858,7 +1855,11 @@ PP(pp_caller)
        PUSHTARG;
     }
     mPUSHs(newSVpv(OutCopFILE(cx->blk_oldcop), 0));
-    mPUSHi((I32)CopLINE(cx->blk_oldcop));
+    lcop = closest_cop(cx->blk_oldcop, cx->blk_oldcop->op_sibling,
+                      cx->blk_sub.retop, TRUE);
+    if (!lcop)
+       lcop = cx->blk_oldcop;
+    mPUSHi((I32)CopLINE(lcop));
     if (!has_arg)
        RETURN;
     if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
@@ -2460,8 +2461,8 @@ PP(pp_return)
        }
        break;
     case CXt_FORMAT:
-       POPFORMAT(cx);
        retop = cx->blk_sub.retop;
+       POPFORMAT(cx);
        break;
     default:
        DIE(aTHX_ "panic: return, type=%u", (unsigned) CxTYPE(cx));
@@ -2550,8 +2551,8 @@ PP(pp_leavesublv)
     S_return_lvalues(aTHX_ newsp, SP, newsp, gimme, cx, newpm);
 
     LEAVE;
-    cxstack_ix--;
     POPSUB(cx,sv);     /* Stack values are safe: release CV and @_ ... */
+    cxstack_ix--;
     PL_curpm = newpm;  /* ... and pop $1 et al */
 
     LEAVESUB(sv);
@@ -2775,7 +2776,7 @@ S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, U32 flags, OP **opstac
     return 0;
 }
 
-PP(pp_goto)
+PP(pp_goto) /* also pp_dump */
 {
     dVAR; dSP;
     OP *retop = NULL;
@@ -2790,6 +2791,8 @@ PP(pp_goto)
     static const char* const must_have_label = "goto must have label";
 
     if (PL_op->op_flags & OPf_STACKED) {
+        /* goto EXPR  or  goto &foo */
+
        SV * const sv = POPs;
        SvGETMAGIC(sv);
 
@@ -2892,21 +2895,28 @@ PP(pp_goto)
                OP* const retop = cx->blk_sub.retop;
                SV **newsp;
                I32 gimme;
-               const SSize_t items = AvFILLp(arg) + 1;
+               const SSize_t items = arg ? AvFILLp(arg) + 1 : 0;
                SV** mark;
 
                 PERL_UNUSED_VAR(newsp);
                 PERL_UNUSED_VAR(gimme);
 
                /* put GvAV(defgv) back onto stack */
-               EXTEND(SP, items+1); /* @_ could have been extended. */
-               Copy(AvARRAY(arg), SP + 1, items, SV*);
+               if (items) {
+                   EXTEND(SP, items+1); /* @_ could have been extended. */
+                   Copy(AvARRAY(arg), SP + 1, items, SV*);
+               }
                mark = SP;
                SP += items;
-               if (AvREAL(arg)) {
-                   I32 index;
+               if (items && AvREAL(arg)) {
+                   SSize_t index;
                    for (index=0; index<items; index++)
-                       SvREFCNT_inc_void(sv_2mortal(SP[-index]));
+                       if (SP[-index])
+                           SvREFCNT_inc_void_NN(sv_2mortal(SP[-index]));
+                       else {
+                           SP[-index] = sv_2mortal(newSVavdefelem(arg,
+                                                AvFILLp(arg) - index, 1));
+                       }
                }
                SvREFCNT_dec(arg);
                if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) {
@@ -2980,11 +2990,13 @@ PP(pp_goto)
            }
        }
        else {
+            /* goto EXPR */
            label       = SvPV_nomg_const(sv, label_len);
             label_flags = SvUTF8(sv);
        }
     }
     else if (!(PL_op->op_flags & OPf_SPECIAL)) {
+        /* goto LABEL  or  dump LABEL */
        label       = cPVOP->op_pv;
         label_flags = (cPVOP->op_private & OPpPV_IS_UTF8) ? SVf_UTF8 : 0;
         label_len   = strlen(label);