if (!(cx->sb_rxtainted & 2) && SvTAINTED(TOPs))
cx->sb_rxtainted |= 2;
sv_catsv(dstr, POPs);
- FREETMPS; /* Prevent excess tmp stack */
/* Are we done */
if (CxONCE(cx) || !CALLREGEXEC(rx, s, cx->sb_strend, orig,
{ /* Update the pos() information. */
SV * const sv = cx->sb_targ;
MAGIC *mg;
- I32 i;
SvUPGRADE(sv, SVt_PVMG);
if (!(mg = mg_find(sv, PERL_MAGIC_regex_global))) {
#ifdef PERL_OLD_COPY_ON_WRITE
mg = sv_magicext(sv, NULL, PERL_MAGIC_regex_global, &PL_vtbl_mglob,
NULL, 0);
}
- i = m - orig;
- if (DO_UTF8(sv))
- sv_pos_b2u(sv, &i);
- mg->mg_len = i;
+ mg->mg_len = m - orig;
}
if (old != rx)
(void)ReREFCNT_inc(rx);
SV * nsv = NULL;
OP * parseres = NULL;
const char *fmt;
- bool oneline;
if (!SvMAGICAL(tmpForm) || !SvCOMPILED(tmpForm)) {
if (SvREADONLY(tmpForm)) {
*t = '\0';
sv_catpvn_utf8_upgrade(PL_formtarget, f, arg, nsv);
t = SvEND(PL_formtarget);
+ f += arg;
break;
}
if (!targ_is_utf8 && DO_UTF8(tmpForm)) {
case FF_LINESNGL:
chopspace = 0;
- oneline = TRUE;
- goto ff_line;
case FF_LINEGLOB:
- oneline = FALSE;
- ff_line:
{
+ const bool oneline = fpc[-1] == FF_LINESNGL;
const char *s = item = SvPV_const(sv, len);
+ item_is_utf8 = DO_UTF8(sv);
itemsize = len;
- if ((item_is_utf8 = DO_UTF8(sv)))
- itemsize = sv_len_utf8(sv);
if (itemsize) {
bool chopped = FALSE;
const char *const send = s + len;
}
}
SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget));
- if (targ_is_utf8)
- SvUTF8_on(PL_formtarget);
if (oneline) {
SvCUR_set(sv, chophere - item);
sv_catsv(PL_formtarget, sv);
SvCUR_set(PL_formtarget, SvCUR(PL_formtarget) - 1);
SvGROW(PL_formtarget, SvCUR(PL_formtarget) + fudge + 1);
t = SvPVX(PL_formtarget) + SvCUR(PL_formtarget);
- if (item_is_utf8)
+ if (item_is_utf8) {
targ_is_utf8 = TRUE;
+ sv_pos_b2u(sv, &itemsize);
+ }
}
break;
}
PL_curpm = newpm; /* ... and pop $1 et al */
LEAVESUB(sv);
- if (clear_errsv)
- sv_setpvn(ERRSV,"",0);
+ if (clear_errsv) {
+ CLEAR_ERRSV();
+ }
return retop;
}
/* First try all the kids at this level, since that's likeliest. */
for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) &&
- kCOP->cop_label && strEQ(kCOP->cop_label, label))
+ CopLABEL(kCOP) && strEQ(CopLABEL(kCOP), label))
return kid;
}
for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
if (saveop && (saveop->op_type != OP_REQUIRE) && (saveop->op_flags & OPf_SPECIAL))
PL_in_eval |= EVAL_KEEPERR;
else
- sv_setpvn(ERRSV,"",0);
+ CLEAR_ERRSV();
if (yyparse() || PL_parser->error_count || !PL_eval_root) {
SV **newsp; /* Used by POPBLOCK. */
PERL_CONTEXT *cx = &cxstack[cxstack_ix];
}
}
- if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVGV) {
+ if (SvROK(arg) && isGV_with_GP(SvRV(arg))) {
arg = SvRV(arg);
}
- if (SvTYPE(arg) == SVt_PVGV) {
+ if (isGV_with_GP(arg)) {
IO * const io = GvIO((GV *)arg);
++filter_has_file;
SAVEHINTS();
PL_hints = 0;
- PL_compiling.cop_hints_hash = NULL;
+ if (PL_compiling.cop_hints_hash) {
+ Perl_refcounted_he_free(aTHX_ PL_compiling.cop_hints_hash);
+ PL_compiling.cop_hints_hash = NULL;
+ }
SAVECOMPILEWARNINGS();
if (PL_dowarn & G_WARN_ALL_ON)
return op;
}
+/* This is a op added to hold the hints hash for
+ pp_entereval. The hash can be modified by the code
+ being eval'ed, so we return a copy instead. */
+
+PP(pp_hintseval)
+{
+ dVAR;
+ dSP;
+ mXPUSHs((SV*)Perl_hv_copy_hints_hv(aTHX_ (HV*)cSVOP_sv));
+ RETURN;
+}
+
+
PP(pp_entereval)
{
dVAR; dSP;
}
else {
LEAVE;
- if (!(save_flags & OPf_SPECIAL))
- sv_setpvn(ERRSV,"",0);
+ if (!(save_flags & OPf_SPECIAL)) {
+ CLEAR_ERRSV();
+ }
}
RETURNOP(retop);
if (flags & G_KEEPERR)
PL_in_eval |= EVAL_KEEPERR;
else
- sv_setpvn(ERRSV,"",0);
+ CLEAR_ERRSV();
if (flags & G_FAKINGEVAL) {
PL_eval_root = PL_op; /* Only needed so that goto works right. */
}
PL_curpm = newpm; /* Don't pop $1 et al till now */
LEAVE;
- sv_setpvn(ERRSV,"",0);
+ CLEAR_ERRSV();
RETURN;
}
&& (Other = d)) )
+# define SM_OBJECT ( \
+ (sv_isobject(d) && (SvTYPE(SvRV(d)) != SVt_REGEXP)) \
+ || \
+ (sv_isobject(e) && (SvTYPE(SvRV(e)) != SVt_REGEXP)) ) \
+
# define SM_OTHER_REF(type) \
(SvROK(Other) && SvTYPE(SvRV(Other)) == SVt_##type)
if (SvGMAGICAL(e))
e = sv_mortalcopy(e);
+ if (SM_OBJECT)
+ Perl_croak(aTHX_ "Smart matching a non-overloaded object breaks encapsulation");
+
if (SM_CV_NEP) {
I32 c;