cx = &cxstack[i];
switch (CxTYPE(cx)) {
case CXt_SUBST:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting substitution via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting substitution via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_SUB:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting subroutine via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting subroutine via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_FORMAT:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting format via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting format via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_EVAL:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting eval via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting eval via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_NULL:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting pseudo-block via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting pseudo-block via %s",
PL_op_name[PL_op->op_type]);
return -1;
case CXt_LOOP:
cx = &cxstack[i];
switch (CxTYPE(cx)) {
case CXt_SUBST:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting substitution via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting substitution via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_SUB:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting subroutine via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting subroutine via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_FORMAT:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting format via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting format via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_EVAL:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting eval via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting eval via %s",
PL_op_name[PL_op->op_type]);
break;
case CXt_NULL:
- if (ckWARN(WARN_UNSAFE))
- Perl_warner(aTHX_ WARN_UNSAFE, "Exiting pseudo-block via %s",
+ if (ckWARN(WARN_EXITING))
+ Perl_warner(aTHX_ WARN_EXITING, "Exiting pseudo-block via %s",
PL_op_name[PL_op->op_type]);
return -1;
case CXt_LOOP:
SvGROW(err, SvCUR(err)+sizeof(prefix)+msglen);
sv_catpvn(err, prefix, sizeof(prefix)-1);
sv_catpvn(err, message, msglen);
- if (ckWARN(WARN_UNSAFE)) {
+ if (ckWARN(WARN_MISC)) {
STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1;
- Perl_warner(aTHX_ WARN_UNSAFE, SvPVX(err)+start);
+ Perl_warner(aTHX_ WARN_MISC, SvPVX(err)+start);
}
}
}
if (MAXARG)
count = POPi;
- EXTEND(SP, 7);
+ EXTEND(SP, 10);
for (;;) {
/* we may be in a higher stacklevel, so dig down deeper */
while (cxix < 0 && top_si->si_type != PERLSI_MAIN) {
* use the global PL_hints) */
PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->op_private &
HINT_PRIVATE_MASK)));
+ {
+ SV * mask ;
+ SV * old_warnings = cx->blk_oldcop->cop_warnings ;
+ if (old_warnings == WARN_NONE || old_warnings == WARN_STD)
+ mask = newSVpvn(WARN_NONEstring, WARNsize) ;
+ else if (old_warnings == WARN_ALL)
+ mask = newSVpvn(WARN_ALLstring, WARNsize) ;
+ else
+ mask = newSVsv(old_warnings);
+ PUSHs(sv_2mortal(mask));
+ }
RETURN;
}
if (cxix < cxstack_ix)
dounwind(cxix);
- cx = &cxstack[cxstack_ix];
- {
- OP *nextop = cx->blk_loop.next_op;
- /* clean scope, but only if there's no continue block */
- if (nextop == cUNOPx(cx->blk_loop.last_op)->op_first->op_next) {
- TOPBLOCK(cx);
- oldsave = PL_scopestack[PL_scopestack_ix - 1];
- LEAVE_SCOPE(oldsave);
- }
- return nextop;
+ TOPBLOCK(cx);
+
+ /* clean scope, but only if there's no continue block */
+ if (!(cx->blk_loop.last_op->op_private & OPpLOOP_CONTINUE)) {
+ oldsave = PL_scopestack[PL_scopestack_ix - 1];
+ LEAVE_SCOPE(oldsave);
}
+ return cx->blk_loop.next_op;
}
PP(pp_redo)
}
}
else if (!SvPOKp(sv)) { /* require 5.005_03 */
- NV n = SvNV(sv);
- rev = (UV)n;
- ver = (UV)((n-rev)*1000);
- sver = (UV)((((n-rev)*1000 - ver) + 0.0009) * 1000);
-
if ((NV)PERL_REVISION + ((NV)PERL_VERSION/(NV)1000)
+ ((NV)PERL_SUBVERSION/(NV)1000000)
+ 0.00000099 < SvNV(sv))
{
+ NV nrev = SvNV(sv);
+ UV rev = (UV)nrev;
+ NV nver = (nrev - rev) * 1000;
+ UV ver = (UV)(nver + 0.0009);
+ NV nsver = (nver - ver) * 1000;
+ UV sver = (UV)(nsver + 0.0009);
+
DIE(aTHX_ "Perl v%"UVuf".%"UVuf".%"UVuf" required--this is only version "
"v%d.%d.%d, stopped", rev, ver, sver, PERL_REVISION,
PERL_VERSION, PERL_SUBVERSION);