/* pp.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
RETURN;
}
+/* Helper function for pp_rv2sv and pp_rv2av */
+GV *
+Perl_softref2xv(pTHX_ SV *const sv, const char *const what, const U32 type,
+ SV ***spp)
+{
+ dVAR;
+ GV *gv;
+
+ if (PL_op->op_private & HINT_STRICT_REFS) {
+ if (SvOK(sv))
+ Perl_die(aTHX_ PL_no_symref_sv, sv, what);
+ else
+ Perl_die(aTHX_ PL_no_usym, what);
+ }
+ if (!SvOK(sv)) {
+ if (PL_op->op_flags & OPf_REF)
+ Perl_die(aTHX_ PL_no_usym, what);
+ if (ckWARN(WARN_UNINITIALIZED))
+ report_uninit(sv);
+ if (type != SVt_PV && GIMME_V == G_ARRAY) {
+ (*spp)--;
+ return NULL;
+ }
+ **spp = &PL_sv_undef;
+ return NULL;
+ }
+ if ((PL_op->op_flags & OPf_SPECIAL) &&
+ !(PL_op->op_flags & OPf_MOD))
+ {
+ gv = gv_fetchsv(sv, 0, type);
+ if (!gv
+ && (!is_gv_magical_sv(sv,0)
+ || !(gv = gv_fetchsv(sv, GV_ADD, type))))
+ {
+ **spp = &PL_sv_undef;
+ return NULL;
+ }
+ }
+ else {
+ gv = gv_fetchsv(sv, GV_ADD, type);
+ }
+ return gv;
+}
+
PP(pp_rv2sv)
{
dVAR; dSP; dTOPss;
if (SvROK(sv))
goto wasref;
}
- if (PL_op->op_private & HINT_STRICT_REFS) {
- if (SvOK(sv))
- DIE(aTHX_ PL_no_symref_sv, sv, "a SCALAR");
- else
- DIE(aTHX_ PL_no_usym, "a SCALAR");
- }
- if (!SvOK(sv)) {
- if (PL_op->op_flags & OPf_REF)
- DIE(aTHX_ PL_no_usym, "a SCALAR");
- if (ckWARN(WARN_UNINITIALIZED))
- report_uninit(sv);
- RETSETUNDEF;
- }
- if ((PL_op->op_flags & OPf_SPECIAL) &&
- !(PL_op->op_flags & OPf_MOD))
- {
- gv = (GV*)gv_fetchsv(sv, 0, SVt_PV);
- if (!gv
- && (!is_gv_magical_sv(sv, 0)
- || !(gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PV))))
- {
- RETSETUNDEF;
- }
- }
- else {
- gv = (GV*)gv_fetchsv(sv, GV_ADD, SVt_PV);
- }
+ gv = Perl_softref2xv(aTHX_ sv, "a SCALAR", SVt_PV, &sp);
+ if (!gv)
+ RETURN;
}
sv = GvSVn(gv);
}
AV * const av = (AV*)TOPs;
SV ** const sv = Perl_av_arylen_p(aTHX_ (AV*)av);
if (!*sv) {
- *sv = newSV(0);
- sv_upgrade(*sv, SVt_PVMG);
+ *sv = newSV_type(SVt_PVMG);
sv_magic(*sv, (SV*)av, PERL_MAGIC_arylen, NULL, 0);
}
SETs(*sv);
char str[ MAX_ARGS_OP * 2 + 2 ]; /* One ';', one '\0' */
if (code == -KEY_chop || code == -KEY_chomp
- || code == -KEY_exec || code == -KEY_system || code == -KEY_err)
+ || code == -KEY_exec || code == -KEY_system)
goto set;
if (code == -KEY_mkdir) {
ret = sv_2mortal(newSVpvs("_;$"));
if (len == 0 && ckWARN(WARN_MISC))
Perl_warner(aTHX_ packWARN(WARN_MISC),
"Explicit blessing to '' (assuming package main)");
- stash = gv_stashpvn(ptr, len, TRUE);
+ stash = gv_stashpvn(ptr, len, GV_ADD);
}
(void)sv_bless(TOPs, stash);
SvSetMagicSV(sv, &PL_sv_undef);
else {
GP *gp;
+ HV *stash;
+
+ /* undef *Foo:: */
+ if((stash = GvHV((GV*)sv)) && HvNAME_get(stash))
+ mro_isa_changed_in(stash);
+ /* undef *Pkg::meth_name ... */
+ else if(GvCVu((GV*)sv) && (stash = GvSTASH((GV*)sv)) && HvNAME_get(stash))
+ mro_method_changed_in(stash);
+
gp_free((GV*)sv);
Newxz(gp, 1, GP);
GvGP(sv) = gp_ref(gp);
PP(pp_pow)
{
- dVAR; dSP; dATARGET;
+ dVAR; dSP; dATARGET; SV *svl, *svr;
#ifdef PERL_PRESERVE_IVUV
bool is_int = 0;
#endif
tryAMAGICbin(pow,opASSIGN);
+ svl = sv_2num(TOPm1s);
+ svr = sv_2num(TOPs);
#ifdef PERL_PRESERVE_IVUV
/* For integer to integer power, we do the calculation by hand wherever
we're sure it is safe; otherwise we call pow() and try to convert to
integer afterwards. */
{
- SvIV_please(TOPs);
- if (SvIOK(TOPs)) {
- SvIV_please(TOPm1s);
- if (SvIOK(TOPm1s)) {
+ SvIV_please(svr);
+ if (SvIOK(svr)) {
+ SvIV_please(svl);
+ if (SvIOK(svl)) {
UV power;
bool baseuok;
UV baseuv;
- if (SvUOK(TOPs)) {
- power = SvUVX(TOPs);
+ if (SvUOK(svr)) {
+ power = SvUVX(svr);
} else {
- const IV iv = SvIVX(TOPs);
+ const IV iv = SvIVX(svr);
if (iv >= 0) {
power = iv;
} else {
}
}
- baseuok = SvUOK(TOPm1s);
+ baseuok = SvUOK(svl);
if (baseuok) {
- baseuv = SvUVX(TOPm1s);
+ baseuv = SvUVX(svl);
} else {
- const IV iv = SvIVX(TOPm1s);
+ const IV iv = SvIVX(svl);
if (iv >= 0) {
baseuv = iv;
baseuok = TRUE; /* effectively it's a UV now */
}
SP--;
SETn( result );
- SvIV_please(TOPs);
+ SvIV_please(svr);
RETURN;
} else {
register unsigned int highbit = 8 * sizeof(UV);
float_it:
#endif
{
- dPOPTOPnnrl;
+ NV right = SvNV(svr);
+ NV left = SvNV(svl);
+ (void)POPs;
#if defined(USE_LONG_DOUBLE) && defined(HAS_AIX_POWL_NEG_BASE_BUG)
/*
#ifdef PERL_PRESERVE_IVUV
if (is_int)
- SvIV_please(TOPs);
+ SvIV_please(svr);
#endif
RETURN;
}
PP(pp_multiply)
{
- dVAR; dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
+ dVAR; dSP; dATARGET; SV *svl, *svr;
+ tryAMAGICbin(mult,opASSIGN);
+ svl = sv_2num(TOPm1s);
+ svr = sv_2num(TOPs);
#ifdef PERL_PRESERVE_IVUV
- SvIV_please(TOPs);
- if (SvIOK(TOPs)) {
+ SvIV_please(svr);
+ if (SvIOK(svr)) {
/* Unless the left argument is integer in range we are going to have to
use NV maths. Hence only attempt to coerce the right argument if
we know the left is integer. */
/* Left operand is defined, so is it IV? */
- SvIV_please(TOPm1s);
- if (SvIOK(TOPm1s)) {
- bool auvok = SvUOK(TOPm1s);
- bool buvok = SvUOK(TOPs);
+ SvIV_please(svl);
+ if (SvIOK(svl)) {
+ bool auvok = SvUOK(svl);
+ bool buvok = SvUOK(svr);
const UV topmask = (~ (UV)0) << (4 * sizeof (UV));
const UV botmask = ~((~ (UV)0) << (4 * sizeof (UV)));
UV alow;
UV bhigh;
if (auvok) {
- alow = SvUVX(TOPm1s);
+ alow = SvUVX(svl);
} else {
- const IV aiv = SvIVX(TOPm1s);
+ const IV aiv = SvIVX(svl);
if (aiv >= 0) {
alow = aiv;
auvok = TRUE; /* effectively it's a UV now */
}
}
if (buvok) {
- blow = SvUVX(TOPs);
+ blow = SvUVX(svr);
} else {
- const IV biv = SvIVX(TOPs);
+ const IV biv = SvIVX(svr);
if (biv >= 0) {
blow = biv;
buvok = TRUE; /* effectively it's a UV now */
}
} /* product_middle too large */
} /* ahigh && bhigh */
- } /* SvIOK(TOPm1s) */
- } /* SvIOK(TOPs) */
+ } /* SvIOK(svl) */
+ } /* SvIOK(svr) */
#endif
{
- dPOPTOPnnrl;
+ NV right = SvNV(svr);
+ NV left = SvNV(svl);
+ (void)POPs;
SETn( left * right );
RETURN;
}
PP(pp_divide)
{
- dVAR; dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
+ dVAR; dSP; dATARGET; SV *svl, *svr;
+ tryAMAGICbin(div,opASSIGN);
+ svl = sv_2num(TOPm1s);
+ svr = sv_2num(TOPs);
/* Only try to do UV divide first
if ((SLOPPYDIVIDE is true) or
(PERL_PRESERVE_IVUV is true and one or both SV is a UV too large
#endif
#ifdef PERL_TRY_UV_DIVIDE
- SvIV_please(TOPs);
- if (SvIOK(TOPs)) {
- SvIV_please(TOPm1s);
- if (SvIOK(TOPm1s)) {
- bool left_non_neg = SvUOK(TOPm1s);
- bool right_non_neg = SvUOK(TOPs);
+ SvIV_please(svr);
+ if (SvIOK(svr)) {
+ SvIV_please(svl);
+ if (SvIOK(svl)) {
+ bool left_non_neg = SvUOK(svl);
+ bool right_non_neg = SvUOK(svr);
UV left;
UV right;
if (right_non_neg) {
- right = SvUVX(TOPs);
+ right = SvUVX(svr);
}
else {
- const IV biv = SvIVX(TOPs);
+ const IV biv = SvIVX(svr);
if (biv >= 0) {
right = biv;
right_non_neg = TRUE; /* effectively it's a UV now */
DIE(aTHX_ "Illegal division by zero");
if (left_non_neg) {
- left = SvUVX(TOPm1s);
+ left = SvUVX(svl);
}
else {
- const IV aiv = SvIVX(TOPm1s);
+ const IV aiv = SvIVX(svl);
if (aiv >= 0) {
left = aiv;
left_non_neg = TRUE; /* effectively it's a UV now */
} /* right wasn't SvIOK */
#endif /* PERL_TRY_UV_DIVIDE */
{
- dPOPPOPnnrl;
+ NV right = SvNV(svr);
+ NV left = SvNV(svl);
+ (void)POPs;(void)POPs;
+#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
+ if (! Perl_isnan(right) && right == 0.0)
+#else
if (right == 0.0)
+#endif
DIE(aTHX_ "Illegal division by zero");
PUSHn( left / right );
RETURN;
bool dright_valid = FALSE;
NV dright = 0.0;
NV dleft = 0.0;
-
- SvIV_please(TOPs);
- if (SvIOK(TOPs)) {
- right_neg = !SvUOK(TOPs);
+ SV * svl;
+ SV * const svr = sv_2num(TOPs);
+ SvIV_please(svr);
+ if (SvIOK(svr)) {
+ right_neg = !SvUOK(svr);
if (!right_neg) {
- right = SvUVX(POPs);
+ right = SvUVX(svr);
} else {
- const IV biv = SvIVX(POPs);
+ const IV biv = SvIVX(svr);
if (biv >= 0) {
right = biv;
right_neg = FALSE; /* effectively it's a UV now */
}
}
else {
- dright = POPn;
+ dright = SvNV(svr);
right_neg = dright < 0;
if (right_neg)
dright = -dright;
use_double = TRUE;
}
}
+ sp--;
/* At this point use_double is only true if right is out of range for
a UV. In range NV has been rounded down to nearest UV and
use_double false. */
- SvIV_please(TOPs);
- if (!use_double && SvIOK(TOPs)) {
- if (SvIOK(TOPs)) {
- left_neg = !SvUOK(TOPs);
+ svl = sv_2num(TOPs);
+ SvIV_please(svl);
+ if (!use_double && SvIOK(svl)) {
+ if (SvIOK(svl)) {
+ left_neg = !SvUOK(svl);
if (!left_neg) {
- left = SvUVX(POPs);
+ left = SvUVX(svl);
} else {
- const IV aiv = SvIVX(POPs);
+ const IV aiv = SvIVX(svl);
if (aiv >= 0) {
left = aiv;
left_neg = FALSE; /* effectively it's a UV now */
}
}
else {
- dleft = POPn;
+ dleft = SvNV(svl);
left_neg = dleft < 0;
if (left_neg)
dleft = -dleft;
}
}
}
+ sp--;
if (use_double) {
NV dans;
count = (IV)nv;
}
else
- count = SvIVx(sv);
+ count = SvIV(sv);
if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
dMARK;
static const char oom_list_extend[] = "Out of memory during list extend";
SvCUR_set(TARG, 0);
else {
const STRLEN max = (UV)count * len;
- if (len > ((MEM_SIZE)~0)/count)
+ if (len > MEM_SIZE_MAX / count)
Perl_croak(aTHX_ oom_string_extend);
MEM_WRAP_CHECK_1(max, char, oom_string_extend);
SvGROW(TARG, max + 1);
PP(pp_subtract)
{
- dVAR; dSP; dATARGET; bool useleft; tryAMAGICbin(subtr,opASSIGN);
- useleft = USE_LEFT(TOPm1s);
+ dVAR; dSP; dATARGET; bool useleft; SV *svl, *svr;
+ tryAMAGICbin(subtr,opASSIGN);
+ svl = sv_2num(TOPm1s);
+ svr = sv_2num(TOPs);
+ useleft = USE_LEFT(svl);
#ifdef PERL_PRESERVE_IVUV
/* See comments in pp_add (in pp_hot.c) about Overflow, and how
"bad things" happen if you rely on signed integers wrapping. */
- SvIV_please(TOPs);
- if (SvIOK(TOPs)) {
+ SvIV_please(svr);
+ if (SvIOK(svr)) {
/* Unless the left argument is integer in range we are going to have to
use NV maths. Hence only attempt to coerce the right argument if
we know the left is integer. */
/* left operand is undef, treat as zero. */
} else {
/* Left operand is defined, so is it IV? */
- SvIV_please(TOPm1s);
- if (SvIOK(TOPm1s)) {
- if ((auvok = SvUOK(TOPm1s)))
- auv = SvUVX(TOPm1s);
+ SvIV_please(svl);
+ if (SvIOK(svl)) {
+ if ((auvok = SvUOK(svl)))
+ auv = SvUVX(svl);
else {
- register const IV aiv = SvIVX(TOPm1s);
+ register const IV aiv = SvIVX(svl);
if (aiv >= 0) {
auv = aiv;
auvok = 1; /* Now acting as a sign flag. */
bool result_good = 0;
UV result;
register UV buv;
- bool buvok = SvUOK(TOPs);
+ bool buvok = SvUOK(svr);
if (buvok)
- buv = SvUVX(TOPs);
+ buv = SvUVX(svr);
else {
- register const IV biv = SvIVX(TOPs);
+ register const IV biv = SvIVX(svr);
if (biv >= 0) {
buv = biv;
buvok = 1;
}
}
#endif
- useleft = USE_LEFT(TOPm1s);
{
- dPOPnv;
+ NV value = SvNV(svr);
+ (void)POPs;
+
if (!useleft) {
/* left operand is undef, treat as zero - value */
SETn(-value);
RETURN;
}
- SETn( TOPn - value );
+ SETn( SvNV(svl) - value );
RETURN;
}
}
{
dVAR; dSP; dTARGET; tryAMAGICun(neg);
{
- dTOPss;
+ SV * const sv = sv_2num(TOPs);
const int flags = SvFLAGS(sv);
SvGETMAGIC(sv);
if ((flags & SVf_IOK) || ((flags & (SVp_IOK | SVp_NOK)) == SVp_IOK)) {
}
}
+#if defined(__GLIBC__) && IVSIZE == 8
STATIC
PP(pp_i_modulo_0)
+#else
+PP(pp_i_modulo)
+#endif
{
/* This is the vanilla old i_modulo. */
dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
#if defined(__GLIBC__) && IVSIZE == 8
STATIC
PP(pp_i_modulo_1)
+
{
/* This is the i_modulo with the workaround for the _moddi3 bug
* in (at least) glibc 2.2.5 (the PERL_ABS() the workaround).
RETURN;
}
}
-#endif
PP(pp_i_modulo)
{
* opcode dispatch table if that is the case, remembering to
* also apply the workaround so that this first round works
* right, too. See [perl #9402] for more information. */
-#if defined(__GLIBC__) && IVSIZE == 8
{
IV l = 3;
IV r = -10;
right = PERL_ABS(right);
}
}
-#endif
/* avoid FPE_INTOVF on some platforms when left is IV_MIN */
if (right == -1)
SETi( 0 );
RETURN;
}
}
+#endif
PP(pp_i_add)
{
{
dVAR; dSP; dTARGET; tryAMAGICun(int);
{
- const IV iv = TOPi; /* attempt to convert to IV if possible. */
+ SV * const sv = sv_2num(TOPs);
+ const IV iv = SvIV(sv);
/* XXX it's arguable that compiler casting to IV might be subtly
different from modf (for numbers inside (IV_MIN,UV_MAX)) in which
else preferring IV has introduced a subtle behaviour change bug. OTOH
relying on floating point to be accurate is a bug. */
- if (!SvOK(TOPs))
+ if (!SvOK(sv)) {
SETu(0);
- else if (SvIOK(TOPs)) {
- if (SvIsUV(TOPs)) {
- const UV uv = TOPu;
- SETu(uv);
- } else
+ }
+ else if (SvIOK(sv)) {
+ if (SvIsUV(sv))
+ SETu(SvUV(sv));
+ else
SETi(iv);
- } else {
- const NV value = TOPn;
+ }
+ else {
+ const NV value = SvNV(sv);
if (value >= 0.0) {
if (value < (NV)UV_MAX + 0.5) {
SETu(U_V(value));
{
dVAR; dSP; dTARGET; tryAMAGICun(abs);
{
+ SV * const sv = sv_2num(TOPs);
/* This will cache the NV value if string isn't actually integer */
- const IV iv = TOPi;
+ const IV iv = SvIV(sv);
- if (!SvOK(TOPs))
+ if (!SvOK(sv)) {
SETu(0);
- else if (SvIOK(TOPs)) {
+ }
+ else if (SvIOK(sv)) {
/* IVX is precise */
- if (SvIsUV(TOPs)) {
- SETu(TOPu); /* force it to be numeric only */
+ if (SvIsUV(sv)) {
+ SETu(SvUV(sv)); /* force it to be numeric only */
} else {
if (iv >= 0) {
SETi(iv);
}
}
} else{
- const NV value = TOPn;
+ const NV value = SvNV(sv);
if (value < 0.0)
SETn(-value);
else
PP(pp_sprintf)
{
dVAR; dSP; dMARK; dORIGMARK; dTARGET;
+ if (SvTAINTED(MARK[1]))
+ TAINT_PROPER("sprintf");
do_sprintf(TARG, SP-MARK, MARK+1);
TAINT_IF(SvTAINTED(TARG));
SP = ORIGMARK;
XPUSHu(DO_UTF8(argsv) ?
utf8n_to_uvchr(s, UTF8_MAXBYTES, 0, UTF8_ALLOW_ANYUV) :
- (*s & 0xff));
+ (UV)(*s & 0xff));
RETURN;
}
need = slen + 1;
}
- if (SvPADTMP(source) && !SvREADONLY(source) && inplace) {
+ if (SvPADTMP(source) && !SvREADONLY(source) && inplace && SvTEMP(source)) {
/* We can convert in place. */
dest = source;
SvGETMAGIC(source);
if (SvPADTMP(source) && !SvREADONLY(source) && !SvAMAGIC(source)
- && !DO_UTF8(source)) {
+ && SvTEMP(source) && !DO_UTF8(source)) {
/* We can convert in place. */
dest = source;
SvGETMAGIC(source);
if (SvPADTMP(source) && !SvREADONLY(source) && !SvAMAGIC(source)
- && !DO_UTF8(source)) {
+ && SvTEMP(source) && !DO_UTF8(source)) {
/* We can convert in place. */
dest = source;
register SV **svp;
I32 max = -1;
for (svp = MARK + 1; svp <= SP; svp++) {
- const I32 elem = SvIVx(*svp);
+ const I32 elem = SvIV(*svp);
if (elem > max)
max = elem;
}
}
while (++MARK <= SP) {
register SV **svp;
- I32 elem = SvIVx(*MARK);
+ I32 elem = SvIV(*MARK);
if (elem > 0)
elem -= arybase;
}
he = hv_fetch_ent(hv, keysv, lval, 0);
- svp = he ? &HeVAL(he) : 0;
+ svp = he ? &HeVAL(he) : NULL;
if (lval) {
if (!svp || *svp == &PL_sv_undef) {
- DIE(aTHX_ PL_no_helem_sv, keysv);
+ DIE(aTHX_ PL_no_helem_sv, SVfARG(keysv));
}
if (localizing) {
if (HvNAME_get(hv) && isGV(*svp))
register SV **lelem;
if (GIMME != G_ARRAY) {
- I32 ix = SvIVx(*lastlelem);
+ I32 ix = SvIV(*lastlelem);
if (ix < 0)
ix += max;
else
}
for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
- I32 ix = SvIVx(*lelem);
+ I32 ix = SvIV(*lelem);
if (ix < 0)
ix += max;
else
SP++;
if (++MARK < SP) {
- offset = i = SvIVx(*MARK);
+ offset = i = SvIV(*MARK);
if (offset < 0)
offset += AvFILLp(ary) + 1;
else
PUSHi( AvFILL(ary) + 1 );
}
else {
+ PL_delaymagic = DM_DELAY;
for (++MARK; MARK <= SP; MARK++) {
SV * const sv = newSV(0);
if (*MARK)
sv_setsv(sv, *MARK);
av_store(ary, AvFILLp(ary)+1, sv);
}
+ if (PL_delaymagic & DM_ARRAY)
+ mg_set((SV*)ary);
+
+ PL_delaymagic = 0;
SP = ORIGMARK;
PUSHi( AvFILLp(ary) + 1 );
}
DIE(aTHX_ "panic: pp_split");
rx = PM_GETRE(pm);
- TAINT_IF((pm->op_pmflags & PMf_LOCALE) &&
- (pm->op_pmflags & (PMf_WHITE | PMf_SKIPWHITE)));
+ TAINT_IF((rx->extflags & RXf_PMf_LOCALE) &&
+ (rx->extflags & (RXf_WHITE | RXf_SKIPWHITE)));
RX_MATCH_UTF8_set(rx, do_utf8);
- if (pm->op_pmreplroot) {
#ifdef USE_ITHREADS
- ary = GvAVn((GV*)PAD_SVl(INT2PTR(PADOFFSET, pm->op_pmreplroot)));
+ if (pm->op_pmreplrootu.op_pmtargetoff) {
+ ary = GvAVn((GV*)PAD_SVl(pm->op_pmreplrootu.op_pmtargetoff));
+ }
#else
- ary = GvAVn((GV*)pm->op_pmreplroot);
-#endif
+ if (pm->op_pmreplrootu.op_pmtargetgv) {
+ ary = GvAVn(pm->op_pmreplrootu.op_pmtargetgv);
}
+#endif
else if (gimme != G_ARRAY)
ary = GvAVn(PL_defgv);
else
}
base = SP - PL_stack_base;
orig = s;
- if (pm->op_pmflags & PMf_SKIPWHITE) {
- if (pm->op_pmflags & PMf_LOCALE) {
+ if (rx->extflags & RXf_SKIPWHITE) {
+ if (do_utf8) {
+ while (*s == ' ' || is_utf8_space((U8*)s))
+ s += UTF8SKIP(s);
+ }
+ else if (rx->extflags & RXf_PMf_LOCALE) {
while (isSPACE_LC(*s))
s++;
}
s++;
}
}
- if (pm->op_pmflags & PMf_MULTILINE) {
+ if (rx->extflags & PMf_MULTILINE) {
multiline = 1;
}
if (!limit)
limit = maxiters + 2;
- if (pm->op_pmflags & PMf_WHITE) {
+ if (rx->extflags & RXf_WHITE) {
while (--limit) {
m = s;
- while (m < strend &&
- !((pm->op_pmflags & PMf_LOCALE)
- ? isSPACE_LC(*m) : isSPACE(*m)))
- ++m;
+ /* this one uses 'm' and is a negative test */
+ if (do_utf8) {
+ while (m < strend && !( *m == ' ' || is_utf8_space((U8*)m) )) {
+ const int t = UTF8SKIP(m);
+ /* is_utf8_space returns FALSE for malform utf8 */
+ if (strend - m < t)
+ m = strend;
+ else
+ m += t;
+ }
+ } else if (rx->extflags & RXf_PMf_LOCALE) {
+ while (m < strend && !isSPACE_LC(*m))
+ ++m;
+ } else {
+ while (m < strend && !isSPACE(*m))
+ ++m;
+ }
if (m >= strend)
break;
(void)SvUTF8_on(dstr);
XPUSHs(dstr);
- s = m + 1;
- while (s < strend &&
- ((pm->op_pmflags & PMf_LOCALE)
- ? isSPACE_LC(*s) : isSPACE(*s)))
- ++s;
+ /* skip the whitespace found last */
+ if (do_utf8)
+ s = m + UTF8SKIP(m);
+ else
+ s = m + 1;
+
+ /* this one uses 's' and is a positive test */
+ if (do_utf8) {
+ while (s < strend && ( *s == ' ' || is_utf8_space((U8*)s) ))
+ s += UTF8SKIP(s);
+ } else if (rx->extflags & RXf_PMf_LOCALE) {
+ while (s < strend && isSPACE_LC(*s))
+ ++s;
+ } else {
+ while (s < strend && isSPACE(*s))
+ ++s;
+ }
}
}
- else if (rx->precomp[0] == '^' && rx->precomp[1] == '\0') {
+ else if (rx->extflags & RXf_START_ONLY) {
while (--limit) {
for (m = s; m < strend && *m != '\n'; m++)
;
s = m;
}
}
- else if (do_utf8 == ((rx->reganch & ROPT_UTF8) != 0) &&
- (rx->reganch & RE_USE_INTUIT) && !rx->nparens
- && (rx->reganch & ROPT_CHECK_ALL)
- && !(rx->reganch & ROPT_ANCH)) {
- const int tail = (rx->reganch & RE_INTUIT_TAIL);
+ else if (rx->extflags & RXf_NULL && !(s >= strend)) {
+ /*
+ Pre-extend the stack, either the number of bytes or
+ characters in the string or a limited amount, triggered by:
+
+ my ($x, $y) = split //, $str;
+ or
+ split //, $str, $i;
+ */
+ const U32 items = limit - 1;
+ if (items < slen)
+ EXTEND(SP, items);
+ else
+ EXTEND(SP, slen);
+
+ if (do_utf8) {
+ while (--limit) {
+ /* keep track of how many bytes we skip over */
+ m = s;
+ s += UTF8SKIP(s);
+ dstr = newSVpvn(m, s-m);
+
+ if (make_mortal)
+ sv_2mortal(dstr);
+
+ (void)SvUTF8_on(dstr);
+ PUSHs(dstr);
+
+ if (s >= strend)
+ break;
+ }
+ } else {
+ while (--limit) {
+ dstr = newSVpvn(s, 1);
+
+ s++;
+
+ if (make_mortal)
+ sv_2mortal(dstr);
+
+ PUSHs(dstr);
+
+ if (s >= strend)
+ break;
+ }
+ }
+ }
+ else if (do_utf8 == ((rx->extflags & RXf_UTF8) != 0) &&
+ (rx->extflags & RXf_USE_INTUIT) && !rx->nparens
+ && (rx->extflags & RXf_CHECK_ALL)
+ && !(rx->extflags & RXf_ANCH)) {
+ const int tail = (rx->extflags & RXf_INTUIT_TAIL);
SV * const csv = CALLREG_INTUIT_STRING(rx);
- len = rx->minlen;
- if (len == 1 && !(rx->reganch & ROPT_UTF8) && !tail) {
+ len = rx->minlenret;
+ if (len == 1 && !(rx->extflags & RXf_UTF8) && !tail) {
const char c = *SvPV_nolen_const(csv);
while (--limit) {
for (m = s; m < strend && *m != c; m++)
s = orig + (m - s);
strend = s + (strend - m);
}
- m = rx->startp[0] + orig;
+ m = rx->offs[0].start + orig;
dstr = newSVpvn(s, m-s);
if (make_mortal)
sv_2mortal(dstr);
if (rx->nparens) {
I32 i;
for (i = 1; i <= (I32)rx->nparens; i++) {
- s = rx->startp[i] + orig;
- m = rx->endp[i] + orig;
+ s = rx->offs[i].start + orig;
+ m = rx->offs[i].end + orig;
/* japhy (07/27/01) -- the (m && s) test doesn't catch
parens that didn't match -- they should be set to
XPUSHs(dstr);
}
}
- s = rx->endp[0] + orig;
+ s = rx->offs[0].end + orig;
}
}
RETURN;
}
+PP(pp_once)
+{
+ dSP;
+ SV *const sv = PAD_SVl(PL_op->op_targ);
+
+ if (SvPADSTALE(sv)) {
+ /* First time. */
+ SvPADSTALE_off(sv);
+ RETURNOP(cLOGOP->op_other);
+ }
+ RETURNOP(cLOGOP->op_next);
+}
+
PP(pp_lock)
{
dVAR;
https://perl5.git.perl.org / perl5.git / blobdiff