SvGETMAGIC(TOPs); /* possibly clear taint on $1 etc: #67962 */
/* See "how taint works" above pp_subst() */
- if (SvTAINTED(TOPs))
- cx->sb_rxtainted |= SUBST_TAINT_REPL;
sv_catsv_nomg(dstr, POPs);
+ if (UNLIKELY(TAINT_get))
+ cx->sb_rxtainted |= SUBST_TAINT_REPL;
if (CxONCE(cx) || s < orig ||
!CALLREGEXEC(rx, s, cx->sb_strend, orig,
(s == m), cx->sb_targ, NULL,
* for safety */
grow = linemax;
while (linemark--)
- s += UTF8SKIP(s);
+ s += UTF8_SAFE_SKIP(s,
+ (U8 *) SvEND(PL_formtarget));
linemark = s - (U8*)SvPVX(PL_formtarget);
}
/* Easy. They agree. */
}
#else
/* we generate fmt ourselves so it is safe */
- GCC_DIAG_IGNORE(-Wformat-nonliteral);
+ GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral);
len = my_snprintf(t, max, fmt, (int) fieldsize, (int) arg, value);
- GCC_DIAG_RESTORE;
+ GCC_DIAG_RESTORE_STMT;
#endif
PERL_MY_SNPRINTF_POST_GUARD(len, max);
RESTORE_LC_NUMERIC();
mask = &PL_sv_undef ;
else if (old_warnings == pWARN_ALL ||
(old_warnings == pWARN_STD && PL_dowarn & G_WARN_ON)) {
- /* Get the bit mask for $warnings::Bits{all}, because
- * it could have been extended by warnings::register */
- SV **bits_all;
- HV * const bits = get_hv("warnings::Bits", 0);
- if (bits && (bits_all=hv_fetchs(bits, "all", FALSE))) {
- mask = newSVsv(*bits_all);
- }
- else {
- mask = newSVpvn(WARN_ALLstring, WARNsize) ;
- }
+ mask = newSVpvn(WARN_ALLstring, WARNsize) ;
}
else
mask = newSVpvn((char *) (old_warnings + 1), old_warnings[0]);
return redo_op;
}
+#define UNENTERABLE (OP *)1
+#define GOTO_DEPTH 64
+
STATIC OP *
S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, U32 flags, OP **opstack, OP **oplimit)
{
o->op_type == OP_SCOPE ||
o->op_type == OP_LEAVELOOP ||
o->op_type == OP_LEAVESUB ||
- o->op_type == OP_LEAVETRY)
+ o->op_type == OP_LEAVETRY ||
+ o->op_type == OP_LEAVEGIVEN)
{
*ops++ = cUNOPo->op_first;
- if (ops >= oplimit)
- Perl_croak(aTHX_ "%s", too_deep);
}
+ else if (oplimit - opstack < GOTO_DEPTH) {
+ if (o->op_flags & OPf_KIDS
+ && cUNOPo->op_first->op_type == OP_PUSHMARK) {
+ *ops++ = UNENTERABLE;
+ }
+ else if (o->op_flags & OPf_KIDS && PL_opargs[o->op_type]
+ && OP_CLASS(o) != OA_LOGOP
+ && o->op_type != OP_LINESEQ
+ && o->op_type != OP_SREFGEN
+ && o->op_type != OP_ENTEREVAL
+ && o->op_type != OP_GLOB
+ && o->op_type != OP_RV2CV) {
+ OP * const kid = cUNOPo->op_first;
+ if (OP_GIMME(kid, 0) != G_SCALAR || OpHAS_SIBLING(kid))
+ *ops++ = UNENTERABLE;
+ }
+ }
+ if (ops >= oplimit)
+ Perl_croak(aTHX_ "%s", too_deep);
*ops = 0;
if (o->op_flags & OPf_KIDS) {
OP *kid;
+ OP * const kid1 = cUNOPo->op_first;
/* First try all the kids at this level, since that's likeliest. */
for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid)) {
if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) {
}
}
for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid)) {
+ bool first_kid_of_binary = FALSE;
if (kid == PL_lastgotoprobe)
continue;
if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) {
if (ops == opstack)
*ops++ = kid;
- else if (ops[-1]->op_type == OP_NEXTSTATE ||
- ops[-1]->op_type == OP_DBSTATE)
+ else if (ops[-1] != UNENTERABLE
+ && (ops[-1]->op_type == OP_NEXTSTATE ||
+ ops[-1]->op_type == OP_DBSTATE))
ops[-1] = kid;
else
*ops++ = kid;
}
+ if (kid == kid1 && ops != opstack && ops[-1] == UNENTERABLE) {
+ first_kid_of_binary = TRUE;
+ ops--;
+ }
if ((o = dofindlabel(kid, label, len, flags, ops, oplimit)))
return o;
+ if (first_kid_of_binary)
+ *ops++ = UNENTERABLE;
}
}
*ops = 0;
}
+static void
+S_check_op_type(pTHX_ OP * const o)
+{
+ /* Eventually we may want to stack the needed arguments
+ * for each op. For now, we punt on the hard ones. */
+ /* XXX This comment seems to me like wishful thinking. --sprout */
+ if (o == UNENTERABLE)
+ Perl_croak(aTHX_
+ "Can't \"goto\" into a binary or list expression");
+ if (o->op_type == OP_ENTERITER)
+ Perl_croak(aTHX_
+ "Can't \"goto\" into the middle of a foreach loop");
+ if (o->op_type == OP_ENTERGIVEN)
+ Perl_croak(aTHX_
+ "Can't \"goto\" into a \"given\" block");
+}
+
/* also used for: pp_dump() */
PP(pp_goto)
OP *retop = NULL;
I32 ix;
PERL_CONTEXT *cx;
-#define GOTO_DEPTH 64
OP *enterops[GOTO_DEPTH];
const char *label = NULL;
STRLEN label_len = 0;
if (leaving_eval && *enterops && enterops[1]) {
I32 i;
for (i = 1; enterops[i]; i++)
- if (enterops[i]->op_type == OP_ENTERITER)
- DIE(aTHX_ "Can't \"goto\" into the middle of a foreach loop");
+ S_check_op_type(aTHX_ enterops[i]);
}
if (*enterops && enterops[1]) {
- I32 i = enterops[1]->op_type == OP_ENTER && in_block ? 2 : 1;
+ I32 i = enterops[1] != UNENTERABLE
+ && enterops[1]->op_type == OP_ENTER && in_block
+ ? 2
+ : 1;
if (enterops[i])
deprecate("\"goto\" to jump into a construct");
}
if (*enterops && enterops[1]) {
OP * const oldop = PL_op;
- ix = enterops[1]->op_type == OP_ENTER && in_block ? 2 : 1;
+ ix = enterops[1] != UNENTERABLE
+ && enterops[1]->op_type == OP_ENTER && in_block
+ ? 2
+ : 1;
for (; enterops[ix]; ix++) {
PL_op = enterops[ix];
- /* Eventually we may want to stack the needed arguments
- * for each op. For now, we punt on the hard ones. */
- if (PL_op->op_type == OP_ENTERITER)
- DIE(aTHX_ "Can't \"goto\" into the middle of a foreach loop");
+ S_check_op_type(aTHX_ PL_op);
+ DEBUG_l( Perl_deb(aTHX_ "pp_goto: Entering %s\n",
+ OP_NAME(PL_op)));
PL_op->op_ppaddr(aTHX);
}
PL_op = oldop;
}
if (c == e && isIDFIRST_lazy_if_safe(name, e, utf8)) {
- sv_catpv(msg, " (you may need to install the ");
+ sv_catpvs(msg, " (you may need to install the ");
for (c = name; c < e; c++) {
if (*c == '/') {
sv_catpvs(msg, "::");
sv_catpvn(msg, c, 1);
}
}
- sv_catpv(msg, " module)");
+ sv_catpvs(msg, " module)");
}
}
else if (memENDs(name, len, ".h")) {
- sv_catpv(msg, " (change .h to .ph maybe?) (did you run h2ph?)");
+ sv_catpvs(msg, " (change .h to .ph maybe?) (did you run h2ph?)");
}
else if (memENDs(name, len, ".ph")) {
- sv_catpv(msg, " (did you run h2ph?)");
+ sv_catpvs(msg, " (did you run h2ph?)");
}
/* diag_listed_as: Can't locate %s */
to the op that follows the leavewhen.
RETURNOP calls PUTBACK which restores the stack pointer after the POPs.
*/
- if (!(PL_op->op_flags & OPf_SPECIAL) && !SvTRUEx(POPs))
+ if (!(PL_op->op_flags & OPf_SPECIAL) && !SvTRUEx(POPs)) {
+ if (gimme == G_SCALAR)
+ PUSHs(&PL_sv_undef);
RETURNOP(cLOGOP->op_other->op_next);
+ }
cx = cx_pushblock(CXt_WHEN, gimme, SP, PL_savestack_ix);
cx_pushwhen(cx);