const char * const name = CopSTASHPV(PL_curcop);
gv = newGVgen(name);
}
- if (SvTYPE(sv) < SVt_RV)
- sv_upgrade(sv, SVt_RV);
+ if (SvTYPE(sv) < SVt_PV && SvTYPE(sv) != SVt_IV)
+ sv_upgrade(sv, SVt_IV);
else if (SvPVX_const(sv)) {
SvPV_free(sv);
SvLEN_set(sv, 0);
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("_;$"));
SvREFCNT_inc_void_NN(sv);
}
rv = sv_newmortal();
- sv_upgrade(rv, SVt_RV);
+ sv_upgrade(rv, SVt_IV);
SvRV_set(rv, sv);
SvROK_on(rv);
return rv;
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
I32 pos;
I32 rem;
I32 fail;
- const int num_args = PL_op->op_private & 7;
- const I32 lvalue = num_args <= 3 && ( PL_op->op_flags & OPf_MOD || LVRET );
+ const I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
const char *tmps;
const I32 arybase = CopARYBASE_get(PL_curcop);
SV *repl_sv = NULL;
const char *repl = NULL;
STRLEN repl_len;
+ const int num_args = PL_op->op_private & 7;
bool repl_need_utf8_upgrade = FALSE;
bool repl_is_utf8 = FALSE;
}
}
- if (GIMME_V != G_VOID && !lvalue)
- sv_setpvn(TARG, tmps, rem);
+ sv_setpvn(TARG, tmps, rem);
#ifdef USE_LOCALE_COLLATE
sv_unmagic(TARG, PERL_MAGIC_collxfrm);
#endif
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;
RETURN;
}
+PP(pp_aeach)
+{
+ dVAR;
+ dSP;
+ AV *array = (AV*)POPs;
+ const I32 gimme = GIMME_V;
+ I32 *iterp = Perl_av_iter_p(aTHX_ array);
+ const IV current = (*iterp)++;
+
+ if (current > av_len(array)) {
+ *iterp = 0;
+ if (gimme == G_SCALAR)
+ RETPUSHUNDEF;
+ else
+ RETURN;
+ }
+
+ EXTEND(SP, 2);
+ mPUSHi(CopARYBASE_get(PL_curcop) + current);
+ if (gimme == G_ARRAY) {
+ SV **const element = av_fetch(array, current, 0);
+ PUSHs(element ? *element : &PL_sv_undef);
+ }
+ RETURN;
+}
+
+PP(pp_akeys)
+{
+ dVAR;
+ dSP;
+ AV *array = (AV*)POPs;
+ const I32 gimme = GIMME_V;
+
+ *Perl_av_iter_p(aTHX_ array) = 0;
+
+ if (gimme == G_SCALAR) {
+ dTARGET;
+ PUSHi(av_len(array) + 1);
+ }
+ else if (gimme == G_ARRAY) {
+ IV n = Perl_av_len(aTHX_ array);
+ IV i = CopARYBASE_get(PL_curcop);
+
+ EXTEND(SP, n + 1);
+
+ if (PL_op->op_type == OP_AKEYS) {
+ n += i;
+ for (; i <= n; i++) {
+ mPUSHi(i);
+ }
+ }
+ else {
+ for (i = 0; i <= n; i++) {
+ SV *const *const elem = Perl_av_fetch(aTHX_ array, i, 0);
+ PUSHs(elem ? *elem : &PL_sv_undef);
+ }
+ }
+ }
+ RETURN;
+}
+
/* Associative arrays. */
PP(pp_each)
}
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) {
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 (rx->extflags & RXf_SKIPWHITE) {
if (do_utf8) {
while (*s == ' ' || is_utf8_space((U8*)s))
s += UTF8SKIP(s);
}
- else if (pm->op_pmflags & PMf_LOCALE) {
+ 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;
/* this one uses 'm' and is a negative test */
else
m += t;
}
- } else if (pm->op_pmflags & PMf_LOCALE) {
+ } else if (rx->extflags & RXf_PMf_LOCALE) {
while (m < strend && !isSPACE_LC(*m))
++m;
} else {
if (do_utf8) {
while (s < strend && ( *s == ' ' || is_utf8_space((U8*)s) ))
s += UTF8SKIP(s);
- } else if (pm->op_pmflags & PMf_LOCALE) {
+ } else if (rx->extflags & RXf_PMf_LOCALE) {
while (s < strend && isSPACE_LC(*s))
++s;
} else {
s = m;
}
}
+ 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)
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;