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;
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:
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:
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);
}
}
}
{
int ret;
OP *oldop = PL_op;
+ OP *retop;
volatile PERL_SI *cursi = PL_curstackinfo;
dJMPENV;
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));
#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;
}
JMPENV_POP;
PL_op = oldop;
- return Nullop;
+ return retop;
}
OP *
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;
}
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)
LEAVE;
sv_setpv(ERRSV,"");
- RETURN;
+ RETURNOP(retop);
}
STATIC void