SvREFCNT_inc_void_NN(sv);
sv = (SV*) gv;
}
- else if (SvTYPE(sv) != SVt_PVGV)
+ else if (!isGV_with_GP(sv))
DIE(aTHX_ "Not a GLOB reference");
}
else {
- if (SvTYPE(sv) != SVt_PVGV) {
+ if (!isGV_with_GP(sv)) {
if (SvGMAGICAL(sv)) {
mg_get(sv);
if (SvROK(sv))
const char * const name = CopSTASHPV(PL_curcop);
gv = newGVgen(name);
}
- if (SvTYPE(sv) < SVt_RV)
- sv_upgrade(sv, SVt_RV);
- else if (SvPVX_const(sv)) {
- SvPV_free(sv);
- SvLEN_set(sv, 0);
- SvCUR_set(sv, 0);
- }
+ prepare_SV_for_RV(sv);
SvRV_set(sv, (SV*)gv);
SvROK_on(sv);
SvSETMAGIC(sv);
/* Helper function for pp_rv2sv and pp_rv2av */
GV *
-Perl_softref2xv(pTHX_ SV *const sv, const char *const what, const U32 type,
- SV ***spp)
+Perl_softref2xv(pTHX_ SV *const sv, const char *const what,
+ const svtype type, SV ***spp)
{
dVAR;
GV *gv;
+ PERL_ARGS_ASSERT_SOFTREF2XV;
+
if (PL_op->op_private & HINT_STRICT_REFS) {
if (SvOK(sv))
Perl_die(aTHX_ PL_no_symref_sv, sv, what);
else {
gv = (GV*)sv;
- if (SvTYPE(gv) != SVt_PVGV) {
+ if (!isGV_with_GP(gv)) {
if (SvGMAGICAL(sv)) {
mg_get(sv);
if (SvROK(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("_;$"));
+ ret = newSVpvs_flags("_;$", SVs_TEMP);
goto set;
}
if (code == -KEY_readpipe) {
if (defgv && str[n - 1] == '$')
str[n - 1] = '_';
str[n++] = '\0';
- ret = sv_2mortal(newSVpvn(str, n - 1));
+ ret = newSVpvn_flags(str, n - 1, SVs_TEMP);
}
else if (code) /* Non-Overridable */
goto set;
}
cv = sv_2cv(TOPs, &stash, &gv, 0);
if (cv && SvPOK(cv))
- ret = sv_2mortal(newSVpvn(SvPVX_const(cv), SvCUR(cv)));
+ ret = newSVpvn_flags(SvPVX_const(cv), SvCUR(cv), SVs_TEMP);
set:
SETs(ret);
RETURN;
dVAR;
SV* rv;
+ PERL_ARGS_ASSERT_REFTO;
+
if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'y') {
if (LvTARGLEN(sv))
vivify_defelem(sv);
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;
break;
case 'N':
if (strEQ(second_letter, "AME"))
- sv = newSVpvn(GvNAME(gv), GvNAMELEN(gv));
+ sv = newSVhek(GvNAME_HEK(gv));
break;
case 'P':
if (strEQ(second_letter, "ACKAGE")) {
}
break;
case SVt_PVGV:
- if (SvFAKE(sv))
+ if (SvFAKE(sv)) {
SvSetMagicSV(sv, &PL_sv_undef);
- else {
+ break;
+ }
+ else if (isGV_with_GP(sv)) {
GP *gp;
HV *stash;
GvLINE(sv) = CopLINE(PL_curcop);
GvEGV(sv) = (GV*)sv;
GvMULTI_on(sv);
+ break;
}
- break;
+ /* FALL THROUGH */
default:
if (SvTYPE(sv) >= SVt_PV && SvPVX_const(sv) && SvLEN(sv)) {
SvPV_free(sv);
PP(pp_predec)
{
dVAR; dSP;
- if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV)
+ if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
DIE(aTHX_ PL_no_modify);
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
&& SvIVX(TOPs) != IV_MIN)
PP(pp_postinc)
{
dVAR; dSP; dTARGET;
- if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV)
+ if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
DIE(aTHX_ PL_no_modify);
sv_setsv(TARG, TOPs);
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
PP(pp_postdec)
{
dVAR; dSP; dTARGET;
- if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV)
+ if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
DIE(aTHX_ PL_no_modify);
sv_setsv(TARG, TOPs);
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
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
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;
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)) {
/* This is the i_modulo with the workaround for the _moddi3 bug
* in (at least) glibc 2.2.5 (the PERL_ABS() the workaround).
* See below for pp_i_modulo. */
- dVAR; dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
+ dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
{
dPOPTOPiirl;
if (!right)
{
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
dVAR; dSP; dTARGET;
SV * const sv = TOPs;
- if (SvAMAGIC(sv)) {
- /* For an overloaded scalar, we can't know in advance if it's going to
- be UTF-8 or not. Also, we can't call sv_len_utf8 as it likes to
- cache the length. Maybe that should be a documented feature of it.
+ if (SvGAMAGIC(sv)) {
+ /* For an overloaded or magic scalar, we can't know in advance if
+ it's going to be UTF-8 or not. Also, we can't call sv_len_utf8 as
+ it likes to cache the length. Maybe that should be a documented
+ feature of it.
*/
STRLEN len;
- const char *const p = SvPV_const(sv, len);
+ const char *const p
+ = sv_2pv_flags(sv, &len,
+ SV_UNDEF_RETURNS_NULL|SV_CONST_RETURN|SV_GMAGIC);
- if (DO_UTF8(sv)) {
+ if (!p)
+ SETs(&PL_sv_undef);
+ else if (DO_UTF8(sv)) {
SETi(utf8_length((U8*)p, (U8*)p + len));
}
else
SETi(len);
-
+ } else if (SvOK(sv)) {
+ /* Neither magic nor overloaded. */
+ if (DO_UTF8(sv))
+ SETi(sv_len_utf8(sv));
+ else
+ SETi(sv_len(sv));
+ } else {
+ SETs(&PL_sv_undef);
}
- else if (DO_UTF8(sv))
- SETi(sv_len_utf8(sv));
- else
- SETi(sv_len(sv));
RETURN;
}
repl = SvPV_const(repl_sv_copy, repl_len);
repl_is_utf8 = DO_UTF8(repl_sv_copy) && SvCUR(sv);
}
- sv_insert(sv, pos, rem, repl, repl_len);
+ if (!SvOK(sv))
+ sv_setpvs(sv, "");
+ sv_insert_flags(sv, pos, rem, repl, repl_len, 0);
if (repl_is_utf8)
SvUTF8_on(sv);
if (repl_sv_copy)
else if (SvOK(sv)) /* is it defined ? */
(void)SvPOK_only_UTF8(sv);
else
- sv_setpvn(sv,"",0); /* avoid lexical reincarnation */
+ sv_setpvs(sv, ""); /* avoid lexical reincarnation */
}
if (SvTYPE(TARG) < SVt_PVLV) {
Otherwise I need to avoid calls to sv_pos_u2b(), which (dangerously)
will trigger magic and overloading again, as will fbm_instr()
*/
- big = sv_2mortal(newSVpvn(big_p, biglen));
- if (big_utf8)
- SvUTF8_on(big);
+ big = newSVpvn_flags(big_p, biglen,
+ SVs_TEMP | (big_utf8 ? SVf_UTF8 : 0));
big_p = SvPVX(big);
}
if (SvGAMAGIC(little) || (is_index && !SvOK(little))) {
This is all getting to messy. The API isn't quite clean enough,
because data access has side effects.
*/
- little = sv_2mortal(newSVpvn(little_p, llen));
- if (little_utf8)
- SvUTF8_on(little);
+ little = newSVpvn_flags(little_p, llen,
+ SVs_TEMP | (little_utf8 ? SVf_UTF8 : 0));
little_p = SvPVX(little);
}
if (SvOK(source)) {
s = (const U8*)SvPV_nomg_const(source, slen);
} else {
+ if (ckWARN(WARN_UNINITIALIZED))
+ report_uninit(source);
s = (const U8*)"";
slen = 0;
}
if (SvOK(source)) {
s = (const U8*)SvPV_nomg_const(source, len);
} else {
+ if (ckWARN(WARN_UNINITIALIZED))
+ report_uninit(source);
s = (const U8*)"";
len = 0;
}
if (SvOK(source)) {
s = (const U8*)SvPV_nomg_const(source, len);
} else {
+ if (ckWARN(WARN_UNINITIALIZED))
+ report_uninit(source);
s = (const U8*)"";
len = 0;
}
RETURN;
}
+PP(pp_aeach)
+{
+ dVAR;
+ dSP;
+ AV *array = (AV*)POPs;
+ const I32 gimme = GIMME_V;
+ IV *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)
const I32 items = SP - MARK;
SV * const av = (SV *) av_make(items, MARK+1);
SP = ORIGMARK; /* av_make() might realloc stack_sp */
- XPUSHs(sv_2mortal((PL_op->op_flags & OPf_SPECIAL)
- ? newRV_noinc(av) : av));
+ mXPUSHs((PL_op->op_flags & OPf_SPECIAL)
+ ? newRV_noinc(av) : av);
RETURN;
}
(void)hv_store_ent(hv,key,val,0);
}
SP = ORIGMARK;
- XPUSHs(sv_2mortal((PL_op->op_flags & OPf_SPECIAL)
- ? newRV_noinc((SV*) hv) : (SV*)hv));
+ mXPUSHs((PL_op->op_flags & OPf_SPECIAL)
+ ? newRV_noinc((SV*) hv) : (SV*) hv);
RETURN;
}
SvUTF8_off(TARG); /* decontaminate */
if (SP - MARK > 1)
do_join(TARG, &PL_sv_no, MARK, SP);
- else
+ else {
sv_setsv(TARG, (SP > MARK)
? *SP
: (padoff_du = find_rundefsvoffset(),
(padoff_du == NOT_IN_PAD
|| PAD_COMPNAME_FLAGS_isOUR(padoff_du))
? DEFSV : PAD_SVl(padoff_du)));
+
+ if (! SvOK(TARG) && ckWARN(WARN_UNINITIALIZED))
+ report_uninit(TARG);
+ }
+
up = SvPV_force(TARG, len);
if (len > 1) {
if (DO_UTF8(TARG)) { /* first reverse each character */
I32 base;
const I32 gimme = GIMME_V;
const I32 oldsave = PL_savestack_ix;
- I32 make_mortal = 1;
+ U32 make_mortal = SVs_TEMP;
bool multiline = 0;
MAGIC *mg = NULL;
DIE(aTHX_ "panic: pp_split");
rx = PM_GETRE(pm);
- TAINT_IF((rx->extflags & RXf_PMf_LOCALE) &&
- (rx->extflags & (RXf_WHITE | RXf_SKIPWHITE)));
+ TAINT_IF((RX_EXTFLAGS(rx) & RXf_PMf_LOCALE) &&
+ (RX_EXTFLAGS(rx) & (RXf_WHITE | RXf_SKIPWHITE)));
RX_MATCH_UTF8_set(rx, do_utf8);
}
base = SP - PL_stack_base;
orig = s;
- if (rx->extflags & RXf_SKIPWHITE) {
+ if (RX_EXTFLAGS(rx) & RXf_SKIPWHITE) {
if (do_utf8) {
while (*s == ' ' || is_utf8_space((U8*)s))
s += UTF8SKIP(s);
}
- else if (rx->extflags & RXf_PMf_LOCALE) {
+ else if (RX_EXTFLAGS(rx) & RXf_PMf_LOCALE) {
while (isSPACE_LC(*s))
s++;
}
s++;
}
}
- if (rx->extflags & PMf_MULTILINE) {
+ if (RX_EXTFLAGS(rx) & PMf_MULTILINE) {
multiline = 1;
}
if (!limit)
limit = maxiters + 2;
- if (rx->extflags & RXf_WHITE) {
+ if (RX_EXTFLAGS(rx) & RXf_WHITE) {
while (--limit) {
m = s;
/* this one uses 'm' and is a negative test */
else
m += t;
}
- } else if (rx->extflags & RXf_PMf_LOCALE) {
+ } else if (RX_EXTFLAGS(rx) & RXf_PMf_LOCALE) {
while (m < strend && !isSPACE_LC(*m))
++m;
} else {
if (m >= strend)
break;
- dstr = newSVpvn(s, m-s);
- if (make_mortal)
- sv_2mortal(dstr);
- if (do_utf8)
- (void)SvUTF8_on(dstr);
+ dstr = newSVpvn_flags(s, m-s,
+ (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
XPUSHs(dstr);
/* skip the whitespace found last */
if (do_utf8) {
while (s < strend && ( *s == ' ' || is_utf8_space((U8*)s) ))
s += UTF8SKIP(s);
- } else if (rx->extflags & RXf_PMf_LOCALE) {
+ } else if (RX_EXTFLAGS(rx) & RXf_PMf_LOCALE) {
while (s < strend && isSPACE_LC(*s))
++s;
} else {
}
}
}
- else if (rx->extflags & RXf_START_ONLY) {
+ else if (RX_EXTFLAGS(rx) & RXf_START_ONLY) {
while (--limit) {
for (m = s; m < strend && *m != '\n'; m++)
;
m++;
if (m >= strend)
break;
- dstr = newSVpvn(s, m-s);
- if (make_mortal)
- sv_2mortal(dstr);
- if (do_utf8)
- (void)SvUTF8_on(dstr);
+ dstr = newSVpvn_flags(s, m-s,
+ (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
XPUSHs(dstr);
s = m;
}
}
- else if (rx->extflags & RXf_NULL && !(s >= strend)) {
+ else if (RX_EXTFLAGS(rx) & RXf_NULL && !(s >= strend)) {
/*
Pre-extend the stack, either the number of bytes or
characters in the string or a limited amount, triggered by:
/* 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);
+ dstr = newSVpvn_flags(m, s-m, SVf_UTF8 | make_mortal);
- (void)SvUTF8_on(dstr);
PUSHs(dstr);
if (s >= strend)
}
}
}
- 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);
+ else if (do_utf8 == (RX_UTF8(rx) != 0) &&
+ (RX_EXTFLAGS(rx) & RXf_USE_INTUIT) && !RX_NPARENS(rx)
+ && (RX_EXTFLAGS(rx) & RXf_CHECK_ALL)
+ && !(RX_EXTFLAGS(rx) & RXf_ANCH)) {
+ const int tail = (RX_EXTFLAGS(rx) & RXf_INTUIT_TAIL);
SV * const csv = CALLREG_INTUIT_STRING(rx);
- len = rx->minlenret;
- if (len == 1 && !(rx->extflags & RXf_UTF8) && !tail) {
+ len = RX_MINLENRET(rx);
+ if (len == 1 && !RX_UTF8(rx) && !tail) {
const char c = *SvPV_nolen_const(csv);
while (--limit) {
for (m = s; m < strend && *m != c; m++)
;
if (m >= strend)
break;
- dstr = newSVpvn(s, m-s);
- if (make_mortal)
- sv_2mortal(dstr);
- if (do_utf8)
- (void)SvUTF8_on(dstr);
+ dstr = newSVpvn_flags(s, m-s,
+ (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
XPUSHs(dstr);
/* The rx->minlen is in characters but we want to step
* s ahead by bytes. */
(m = fbm_instr((unsigned char*)s, (unsigned char*)strend,
csv, multiline ? FBMrf_MULTILINE : 0)) )
{
- dstr = newSVpvn(s, m-s);
- if (make_mortal)
- sv_2mortal(dstr);
- if (do_utf8)
- (void)SvUTF8_on(dstr);
+ dstr = newSVpvn_flags(s, m-s,
+ (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
XPUSHs(dstr);
/* The rx->minlen is in characters but we want to step
* s ahead by bytes. */
}
}
else {
- maxiters += slen * rx->nparens;
+ maxiters += slen * RX_NPARENS(rx);
while (s < strend && --limit)
{
I32 rex_return;
if (rex_return == 0)
break;
TAINT_IF(RX_MATCH_TAINTED(rx));
- if (RX_MATCH_COPIED(rx) && rx->subbeg != orig) {
+ if (RX_MATCH_COPIED(rx) && RX_SUBBEG(rx) != orig) {
m = s;
s = orig;
- orig = rx->subbeg;
+ orig = RX_SUBBEG(rx);
s = orig + (m - s);
strend = s + (strend - m);
}
- m = rx->offs[0].start + orig;
- dstr = newSVpvn(s, m-s);
- if (make_mortal)
- sv_2mortal(dstr);
- if (do_utf8)
- (void)SvUTF8_on(dstr);
+ m = RX_OFFS(rx)[0].start + orig;
+ dstr = newSVpvn_flags(s, m-s,
+ (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
XPUSHs(dstr);
- if (rx->nparens) {
+ if (RX_NPARENS(rx)) {
I32 i;
- for (i = 1; i <= (I32)rx->nparens; i++) {
- s = rx->offs[i].start + orig;
- m = rx->offs[i].end + orig;
+ for (i = 1; i <= (I32)RX_NPARENS(rx); i++) {
+ s = RX_OFFS(rx)[i].start + orig;
+ m = RX_OFFS(rx)[i].end + orig;
/* japhy (07/27/01) -- the (m && s) test doesn't catch
parens that didn't match -- they should be set to
undef, not the empty string */
if (m >= orig && s >= orig) {
- dstr = newSVpvn(s, m-s);
+ dstr = newSVpvn_flags(s, m-s,
+ (do_utf8 ? SVf_UTF8 : 0)
+ | make_mortal);
}
else
dstr = &PL_sv_undef; /* undef, not "" */
- if (make_mortal)
- sv_2mortal(dstr);
- if (do_utf8)
- (void)SvUTF8_on(dstr);
XPUSHs(dstr);
}
}
- s = rx->offs[0].end + orig;
+ s = RX_OFFS(rx)[0].end + orig;
}
}
/* keep field after final delim? */
if (s < strend || (iters && origlimit)) {
const STRLEN l = strend - s;
- dstr = newSVpvn(s, l);
- if (make_mortal)
- sv_2mortal(dstr);
- if (do_utf8)
- (void)SvUTF8_on(dstr);
+ dstr = newSVpvn_flags(s, l, (do_utf8 ? SVf_UTF8 : 0) | make_mortal);
XPUSHs(dstr);
iters++;
}
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