dSP;
register PMOP *pm = (PMOP*)cLOGOP->op_other;
SV *tmpstr;
- regexp *re = NULL;
+ REGEXP *re = NULL;
/* prevent recompiling under /o and ithreads. */
#if defined(USE_ITHREADS)
if (SvROK(tmpstr)) {
SV * const sv = SvRV(tmpstr);
if (SvTYPE(sv) == SVt_REGEXP)
- re = ((struct xregexp *)SvANY(sv))->xrx_regexp;
+ re = (REGEXP*) sv;
}
if (re) {
re = reg_temp_copy(re);
STRLEN len;
const char *t = SvOK(tmpstr) ? SvPV_const(tmpstr, len) : "";
re = PM_GETRE(pm);
+ assert (re != (REGEXP*) &PL_sv_undef);
/* Check against the last compiled regexp. */
- if (!re || !RX_PRECOMP(re) || RX_PRELEN(re) != (I32)len ||
+ if (!re || !RX_PRECOMP(re) || RX_PRELEN(re) != len ||
memNE(RX_PRECOMP(re), t, len))
{
- const regexp_engine *eng = re ? re->engine : NULL;
+ const regexp_engine *eng = re ? RX_ENGINE(re) : NULL;
U32 pm_flags = pm->op_pmflags & PMf_COMPILETIME;
if (re) {
ReREFCNT_dec(re);
+#ifdef USE_ITHREADS
+ PM_SETRE(pm, (REGEXP*) &PL_sv_undef);
+#else
PM_SETRE(pm, NULL); /* crucial if regcomp aborts */
+#endif
} else if (PL_curcop->cop_hints_hash) {
SV *ptr = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash, 0,
"regcomp", 7, 0, 0);
if (PL_op->op_flags & OPf_SPECIAL)
PL_reginterp_cnt = I32_MAX; /* Mark as safe. */
- if (DO_UTF8(tmpstr))
- pm_flags |= RXf_UTF8;
+ if (DO_UTF8(tmpstr)) {
+ assert (SvUTF8(tmpstr));
+ } else if (SvUTF8(tmpstr)) {
+ /* Not doing UTF-8, despite what the SV says. Is this only if
+ we're trapped in use 'bytes'? */
+ /* Make a copy of the octet sequence, but without the flag on,
+ as the compiler now honours the SvUTF8 flag on tmpstr. */
+ STRLEN len;
+ const char *const p = SvPV(tmpstr, len);
+ tmpstr = newSVpvn_flags(p, len, SVs_TEMP);
+ }
if (eng)
PM_SETRE(pm, CALLREGCOMP_ENG(eng, tmpstr, pm_flags));
#ifndef INCOMPLETE_TAINTS
if (PL_tainting) {
if (PL_tainted)
- re->extflags |= RXf_TAINTED;
+ RX_EXTFLAGS(re) |= RXf_TAINTED;
else
- re->extflags &= ~RXf_TAINTED;
+ RX_EXTFLAGS(re) &= ~RXf_TAINTED;
}
#endif
SvPV_set(dstr, NULL);
TAINT_IF(cx->sb_rxtainted & 1);
- PUSHs(sv_2mortal(newSViv(saviters - 1)));
+ mPUSHi(saviters - 1);
(void)SvPOK_only_UTF8(targ);
TAINT_IF(cx->sb_rxtainted);
}
cx->sb_iters = saviters;
}
- if (RX_MATCH_COPIED(rx) && rx->subbeg != orig) {
+ if (RX_MATCH_COPIED(rx) && RX_SUBBEG(rx) != orig) {
m = s;
s = orig;
- cx->sb_orig = orig = rx->subbeg;
+ cx->sb_orig = orig = RX_SUBBEG(rx);
s = orig + (m - s);
cx->sb_strend = s + (cx->sb_strend - m);
}
- cx->sb_m = m = rx->offs[0].start + orig;
+ cx->sb_m = m = RX_OFFS(rx)[0].start + orig;
if (m > s) {
if (DO_UTF8(dstr) && !SvUTF8(cx->sb_targ))
sv_catpvn_utf8_upgrade(dstr, s, m - s, nsv);
else
sv_catpvn(dstr, s, m-s);
}
- cx->sb_s = rx->offs[0].end + orig;
+ cx->sb_s = RX_OFFS(rx)[0].end + orig;
{ /* Update the pos() information. */
SV * const sv = cx->sb_targ;
MAGIC *mg;
U32 i;
PERL_UNUSED_CONTEXT;
- if (!p || p[1] < rx->nparens) {
+ if (!p || p[1] < RX_NPARENS(rx)) {
#ifdef PERL_OLD_COPY_ON_WRITE
- i = 7 + rx->nparens * 2;
+ i = 7 + RX_NPARENS(rx) * 2;
#else
- i = 6 + rx->nparens * 2;
+ i = 6 + RX_NPARENS(rx) * 2;
#endif
if (!p)
Newx(p, i, UV);
*rsp = (void*)p;
}
- *p++ = PTR2UV(RX_MATCH_COPIED(rx) ? rx->subbeg : NULL);
+ *p++ = PTR2UV(RX_MATCH_COPIED(rx) ? RX_SUBBEG(rx) : NULL);
RX_MATCH_COPIED_off(rx);
#ifdef PERL_OLD_COPY_ON_WRITE
- *p++ = PTR2UV(rx->saved_copy);
- rx->saved_copy = NULL;
+ *p++ = PTR2UV(RX_SAVED_COPY(rx));
+ RX_SAVED_COPY(rx) = NULL;
#endif
- *p++ = rx->nparens;
+ *p++ = RX_NPARENS(rx);
- *p++ = PTR2UV(rx->subbeg);
- *p++ = (UV)rx->sublen;
- for (i = 0; i <= rx->nparens; ++i) {
- *p++ = (UV)rx->offs[i].start;
- *p++ = (UV)rx->offs[i].end;
+ *p++ = PTR2UV(RX_SUBBEG(rx));
+ *p++ = (UV)RX_SUBLEN(rx);
+ for (i = 0; i <= RX_NPARENS(rx); ++i) {
+ *p++ = (UV)RX_OFFS(rx)[i].start;
+ *p++ = (UV)RX_OFFS(rx)[i].end;
}
}
*p++ = 0;
#ifdef PERL_OLD_COPY_ON_WRITE
- if (rx->saved_copy)
- SvREFCNT_dec (rx->saved_copy);
- rx->saved_copy = INT2PTR(SV*,*p);
+ if (RX_SAVED_COPY(rx))
+ SvREFCNT_dec (RX_SAVED_COPY(rx));
+ RX_SAVED_COPY(rx) = INT2PTR(SV*,*p);
*p++ = 0;
#endif
- rx->nparens = *p++;
+ RX_NPARENS(rx) = *p++;
- rx->subbeg = INT2PTR(char*,*p++);
- rx->sublen = (I32)(*p++);
- for (i = 0; i <= rx->nparens; ++i) {
- rx->offs[i].start = (I32)(*p++);
- rx->offs[i].end = (I32)(*p++);
+ RX_SUBBEG(rx) = INT2PTR(char*,*p++);
+ RX_SUBLEN(rx) = (I32)(*p++);
+ for (i = 0; i <= RX_NPARENS(rx); ++i) {
+ RX_OFFS(rx)[i].start = (I32)(*p++);
+ RX_OFFS(rx)[i].end = (I32)(*p++);
}
}
if (PL_stack_base + *PL_markstack_ptr == SP) {
(void)POPMARK;
if (GIMME_V == G_SCALAR)
- XPUSHs(sv_2mortal(newSViv(0)));
+ mXPUSHi(0);
RETURNOP(PL_op->op_next->op_next);
}
PL_stack_sp = PL_stack_base + *PL_markstack_ptr + 1;
if (!stashname)
PUSHs(&PL_sv_undef);
else
- PUSHs(sv_2mortal(newSVpv(stashname, 0)));
- PUSHs(sv_2mortal(newSVpv(OutCopFILE(cx->blk_oldcop), 0)));
- PUSHs(sv_2mortal(newSViv((I32)CopLINE(cx->blk_oldcop))));
+ mPUSHs(newSVpv(stashname, 0));
+ mPUSHs(newSVpv(OutCopFILE(cx->blk_oldcop), 0));
+ mPUSHi((I32)CopLINE(cx->blk_oldcop));
if (!MAXARG)
RETURN;
if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
if (isGV(cvgv)) {
SV * const sv = newSV(0);
gv_efullname3(sv, cvgv, NULL);
- PUSHs(sv_2mortal(sv));
- PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs)));
+ mPUSHs(sv);
+ mPUSHi((I32)cx->blk_sub.hasargs);
}
else {
- PUSHs(sv_2mortal(newSVpvs("(unknown)")));
- PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs)));
+ PUSHs(newSVpvs_flags("(unknown)", SVs_TEMP));
+ mPUSHi((I32)cx->blk_sub.hasargs);
}
}
else {
- PUSHs(sv_2mortal(newSVpvs("(eval)")));
- PUSHs(sv_2mortal(newSViv(0)));
+ PUSHs(newSVpvs_flags("(eval)", SVs_TEMP));
+ mPUSHi(0);
}
gimme = (I32)cx->blk_gimme;
if (gimme == G_VOID)
PUSHs(&PL_sv_undef);
else
- PUSHs(sv_2mortal(newSViv(gimme & G_ARRAY)));
+ mPUSHi(gimme & G_ARRAY);
if (CxTYPE(cx) == CXt_EVAL) {
/* eval STRING */
if (cx->blk_eval.old_op_type == OP_ENTEREVAL) {
}
/* require */
else if (cx->blk_eval.old_namesv) {
- PUSHs(sv_2mortal(newSVsv(cx->blk_eval.old_namesv)));
+ mPUSHs(newSVsv(cx->blk_eval.old_namesv));
PUSHs(&PL_sv_yes);
}
/* eval BLOCK (try blocks have old_namesv == 0) */
/* XXX only hints propagated via op_private are currently
* visible (others are not easily accessible, since they
* use the global PL_hints) */
- PUSHs(sv_2mortal(newSViv(CopHINTS_get(cx->blk_oldcop))));
+ mPUSHi(CopHINTS_get(cx->blk_oldcop));
{
SV * mask ;
STRLEN * const old_warnings = cx->blk_oldcop->cop_warnings ;
}
else
mask = newSVpvn((char *) (old_warnings + 1), old_warnings[0]);
- PUSHs(sv_2mortal(mask));
+ mPUSHs(mask);
}
PUSHs(cx->blk_oldcop->cop_hints_hash ?
SvGETMAGIC(sv);
SvGETMAGIC(right);
if (RANGE_IS_NUMERIC(sv,right)) {
- if ((SvOK(sv) && SvNV(sv) < IV_MIN) ||
- (SvOK(right) && SvNV(right) >= IV_MAX))
+#ifdef NV_PRESERVES_UV
+ if ((SvOK(sv) && ((SvNV(sv) < (NV)IV_MIN) ||
+ (SvNV(sv) > (NV)IV_MAX)))
+ ||
+ (SvOK(right) && ((SvNV(right) > (NV)IV_MAX) ||
+ (SvNV(right) < (NV)IV_MIN))))
+#else
+ if ((SvOK(sv) && ((SvNV(sv) <= (NV)IV_MIN)
+ ||
+ ((SvNV(sv) > 0) &&
+ ((SvUV(sv) > (UV)IV_MAX) ||
+ (SvNV(sv) > (NV)UV_MAX)))))
+ ||
+ (SvOK(right) && ((SvNV(right) <= (NV)IV_MIN)
+ ||
+ ((SvNV(right) > 0) &&
+ ((SvUV(right) > (UV)IV_MAX) ||
+ (SvNV(right) > (NV)UV_MAX))))))
+#endif
DIE(aTHX_ "Range iterator outside integer range");
cx->blk_loop.iterix = SvIV(sv);
cx->blk_loop.itermax = SvIV(right);
if (CvDEPTH(cv) < 2)
SvREFCNT_inc_simple_void_NN(cv);
else {
- if (CvDEPTH(cv) == 100 && ckWARN(WARN_RECURSION))
+ if (CvDEPTH(cv) == PERL_SUB_DEPTH_WARN && ckWARN(WARN_RECURSION))
sub_crush_depth(cv);
pad_push(padlist, CvDEPTH(cv));
}
sv = POPs;
if ( (SvNIOKp(sv) || SvVOK(sv)) && PL_op->op_type != OP_DOFILE) {
- if ( SvVOK(sv) && ckWARN(WARN_PORTABLE) ) { /* require v5.6.1 */
- HV * hinthv = GvHV(PL_hintgv);
- SV ** ptr = NULL;
- if (hinthv) ptr = hv_fetchs(hinthv, "v_string", FALSE);
- if ( !(ptr && *ptr && SvIOK(*ptr) && SvIV(*ptr)) )
- Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
- "v-string in use/require non-portable");
- }
sv = new_version(sv);
if (!sv_derived_from(PL_patchlevel, "version"))
upg_version(PL_patchlevel, TRUE);
/* We do this only with use, not require. */
if (PL_compcv &&
- /* If we request a version >= 5.6.0, then v-string are OK
- so set $^H{v_string} to suppress the v-string warning */
- vcmp(sv, sv_2mortal(upg_version(newSVnv(5.006), FALSE))) >= 0) {
- HV * hinthv = GvHV(PL_hintgv);
- if( hinthv ) {
- SV *hint = newSViv(1);
- (void)hv_stores(hinthv, "v_string", hint);
- /* This will call through to Perl_magic_sethint() which in turn
- sets PL_hints correctly. */
- SvSETMAGIC(hint);
- }
/* If we request a version >= 5.9.5, load feature.pm with the
* feature bundle that corresponds to the required version. */
- if (vcmp(sv, sv_2mortal(upg_version(newSVnv(5.009005), FALSE))) >= 0) {
+ vcmp(sv, sv_2mortal(upg_version(newSVnv(5.009005), FALSE))) >= 0) {
SV *const importsv = vnormal(sv);
*SvPVX_mutable(importsv) = ':';
ENTER;
Perl_load_module(aTHX_ 0, newSVpvs("feature"), NULL, importsv, NULL);
LEAVE;
- }
}
RETPUSHYES;
if (vms_unixname)
#endif
{
- namesv = newSV(0);
- sv_upgrade(namesv, SVt_PV);
+ namesv = newSV_type(SVt_PV);
for (i = 0; i <= AvFILL(ar); i++) {
SV * const dirsv = *av_fetch(ar, i, TRUE);
/* Helper routines used by pp_smartmatch */
STATIC PMOP *
-S_make_matcher(pTHX_ regexp *re)
+S_make_matcher(pTHX_ REGEXP *re)
{
dVAR;
PMOP *matcher = (PMOP *) newPMOP(OP_MATCH, OPf_WANT_SCALAR | OPf_STACKED);
SV *e = TOPs; /* e is for 'expression' */
SV *d = TOPm1s; /* d is for 'default', as in PL_defgv */
SV *This, *Other; /* 'This' (and Other to match) to play with C++ */
- regexp *this_regex, *other_regex;
+ REGEXP *this_regex, *other_regex;
# define NOT_EMPTY_PROTO(cv) (!SvPOK(cv) || SvCUR(cv) == 0)
# define SM_REGEX ( \
(SvROK(d) && (SvTYPE(This = SvRV(d)) == SVt_REGEXP) \
- && (this_regex = ((struct xregexp *)SvANY(This))->xrx_regexp) \
+ && (this_regex = (REGEXP*) This) \
&& (Other = e)) \
|| \
(SvROK(e) && (SvTYPE(This = SvRV(e)) == SVt_REGEXP) \
- && (this_regex = ((struct xregexp *)SvANY(This))->xrx_regexp) \
+ && (this_regex = (REGEXP*) This) \
&& (Other = d)) )
# define SM_OTHER_REGEX (SvROK(Other) \
&& (SvTYPE(SvRV(Other)) == SVt_REGEXP) \
- && (other_regex = ((struct xregexp *)SvANY(SvRV(Other)))->xrx_regexp))
+ && (other_regex = (REGEXP*) SvRV(Other)))
# define SM_SEEN_THIS(sv) hv_exists_ent(seen_this, \
DEFSV = upstream;
PUSHMARK(SP);
- PUSHs(sv_2mortal(newSViv(0)));
+ mPUSHi(0);
if (filter_state) {
PUSHs(filter_state);
}
https://perl5.git.perl.org / perl5.git / blobdiff