Various tweaks to Encode

[p5sagit/p5-mst-13.2.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 81a96de..886dd8c 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -396,7 +396,7 @@ PP(pp_formline)
            else {
                sv = &PL_sv_no;
                if (ckWARN(WARN_SYNTAX))
-                   Perl_warner(aTHX_ WARN_SYNTAX, "Not enough format arguments");
+                   Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Not enough format arguments");
            }
            break;
 
@@ -1022,27 +1022,27 @@ S_dopoptolabel(pTHX_ char *label)
        switch (CxTYPE(cx)) {
        case CXt_SUBST:
            if (ckWARN(WARN_EXITING))
-               Perl_warner(aTHX_ WARN_EXITING, "Exiting substitution via %s",
+               Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting substitution via %s",
                        OP_NAME(PL_op));
            break;
        case CXt_SUB:
            if (ckWARN(WARN_EXITING))
-               Perl_warner(aTHX_ WARN_EXITING, "Exiting subroutine via %s",
+               Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting subroutine via %s",
                        OP_NAME(PL_op));
            break;
        case CXt_FORMAT:
            if (ckWARN(WARN_EXITING))
-               Perl_warner(aTHX_ WARN_EXITING, "Exiting format via %s",
+               Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting format via %s",
                        OP_NAME(PL_op));
            break;
        case CXt_EVAL:
            if (ckWARN(WARN_EXITING))
-               Perl_warner(aTHX_ WARN_EXITING, "Exiting eval via %s",
+               Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting eval via %s",
                        OP_NAME(PL_op));
            break;
        case CXt_NULL:
            if (ckWARN(WARN_EXITING))
-               Perl_warner(aTHX_ WARN_EXITING, "Exiting pseudo-block via %s",
+               Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting pseudo-block via %s",
                        OP_NAME(PL_op));
            return -1;
        case CXt_LOOP:
@@ -1157,27 +1157,27 @@ S_dopoptoloop(pTHX_ I32 startingblock)
        switch (CxTYPE(cx)) {
        case CXt_SUBST:
            if (ckWARN(WARN_EXITING))
-               Perl_warner(aTHX_ WARN_EXITING, "Exiting substitution via %s",
+               Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting substitution via %s",
                        OP_NAME(PL_op));
            break;
        case CXt_SUB:
            if (ckWARN(WARN_EXITING))
-               Perl_warner(aTHX_ WARN_EXITING, "Exiting subroutine via %s",
+               Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting subroutine via %s",
                        OP_NAME(PL_op));
            break;
        case CXt_FORMAT:
            if (ckWARN(WARN_EXITING))
-               Perl_warner(aTHX_ WARN_EXITING, "Exiting format via %s",
+               Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting format via %s",
                        OP_NAME(PL_op));
            break;
        case CXt_EVAL:
            if (ckWARN(WARN_EXITING))
-               Perl_warner(aTHX_ WARN_EXITING, "Exiting eval via %s",
+               Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting eval via %s",
                        OP_NAME(PL_op));
            break;
        case CXt_NULL:
            if (ckWARN(WARN_EXITING))
-               Perl_warner(aTHX_ WARN_EXITING, "Exiting pseudo-block via %s",
+               Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting pseudo-block via %s",
                        OP_NAME(PL_op));
            return -1;
        case CXt_LOOP:
@@ -1268,7 +1268,7 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen)
                    sv_catpvn(err, message, msglen);
                    if (ckWARN(WARN_MISC)) {
                        STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1;
-                       Perl_warner(aTHX_ WARN_MISC, SvPVX(err)+start);
+                       Perl_warner(aTHX_ packWARN(WARN_MISC), SvPVX(err)+start);
                    }
                }
            }
@@ -2535,6 +2535,7 @@ S_docatch(pTHX_ OP *o)
 {
     int ret;
     OP *oldop = PL_op;
+    OP *retop;
     volatile PERL_SI *cursi = PL_curstackinfo;
     dJMPENV;
 
@@ -2542,6 +2543,15 @@ S_docatch(pTHX_ OP *o)
     assert(CATCH_GET == TRUE);
 #endif
     PL_op = o;
+
+    /* Normally, the leavetry at the end of this block of ops will
+     * pop an op off the return stack and continue there. By setting
+     * the op to Nullop, we force an exit from the inner runops()
+     * loop. DAPM.
+     */
+    retop = pop_return();
+    push_return(Nullop);
+
 #ifdef PERL_FLEXIBLE_EXCEPTIONS
  redo_body:
     CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_docatch_body));
@@ -2556,11 +2566,15 @@ S_docatch(pTHX_ OP *o)
 #endif
        break;
     case 3:
+       /* die caught by an inner eval - continue inner loop */
        if (PL_restartop && cursi == PL_curstackinfo) {
            PL_op = PL_restartop;
            PL_restartop = 0;
            goto redo_body;
        }
+       /* a die in this eval - continue in outer loop */
+       if (!PL_restartop)
+           break;
        /* FALL THROUGH */
     default:
        JMPENV_POP;
@@ -2570,7 +2584,7 @@ S_docatch(pTHX_ OP *o)
     }
     JMPENV_POP;
     PL_op = oldop;
-    return Nullop;
+    return retop;
 }
 
 OP *
@@ -2913,7 +2927,7 @@ PP(pp_require)
                    PERL_VERSION, PERL_SUBVERSION);
            }
            if (ckWARN(WARN_PORTABLE))
-               Perl_warner(aTHX_ WARN_PORTABLE,
+               Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
                         "v-string in use/require non-portable");
            RETPUSHYES;
        }
@@ -3414,13 +3428,14 @@ PP(pp_leavetry)
     register SV **mark;
     SV **newsp;
     PMOP *newpm;
+    OP* retop;
     I32 gimme;
     register PERL_CONTEXT *cx;
     I32 optype;
 
     POPBLOCK(cx,newpm);
     POPEVAL(cx);
-    pop_return();
+    retop = pop_return();
 
     TAINT_NOT;
     if (gimme == G_VOID)
@@ -3452,7 +3467,7 @@ PP(pp_leavetry)
 
     LEAVE;
     sv_setpv(ERRSV,"");
-    RETURN;
+    RETURNOP(retop);
 }
 
 STATIC void