}
}
+/* push the elements of av onto the stack.
+ * XXX Note that padav has similar code but without the mg_get().
+ * I suspect that the mg_get is no longer needed, but while padav
+ * differs, it can't share this function */
+
+void
+S_pushav(pTHX_ AV* const av)
+{
+ dSP;
+ const I32 maxarg = AvFILL(av) + 1;
+ EXTEND(SP, maxarg);
+ if (SvRMAGICAL(av)) {
+ U32 i;
+ for (i=0; i < (U32)maxarg; i++) {
+ SV ** const svp = av_fetch(av, i, FALSE);
+ /* See note in pp_helem, and bug id #27839 */
+ SP[i+1] = svp
+ ? SvGMAGICAL(*svp) ? (mg_get(*svp), *svp) : *svp
+ : &PL_sv_undef;
+ }
+ }
+ else {
+ Copy(AvARRAY(av), SP+1, maxarg, SV*);
+ }
+ SP += maxarg;
+ PUTBACK;
+}
+
+
/* ($lex1,@lex2,...) or my ($lex1,@lex2,...) */
PP(pp_padrange)
PADOFFSET base = PL_op->op_targ;
int count = (int)(PL_op->op_private) & OPpPADRANGE_COUNTMASK;
int i;
+ if (PL_op->op_flags & OPf_SPECIAL) {
+ /* fake the RHS of my ($x,$y,..) = @_ */
+ PUSHMARK(SP);
+ S_pushav(aTHX_ GvAVn(PL_defgv));
+ SPAGAIN;
+ }
+
/* note, this is only skipped for compile-time-known void cxt */
if ((PL_op->op_flags & OPf_WANT) != OPf_WANT_VOID) {
EXTEND(SP, count);
*++SP = PAD_SV(base+i);
}
if (PL_op->op_private & OPpLVAL_INTRO) {
+ SV **svp = &(PAD_SVl(base));
+ const UV payload = (UV)(
+ (base << (OPpPADRANGE_COUNTSHIFT + SAVE_TIGHT_SHIFT))
+ | (count << SAVE_TIGHT_SHIFT)
+ | SAVEt_CLEARPADRANGE);
+ assert(OPpPADRANGE_COUNTMASK + 1 == (1 <<OPpPADRANGE_COUNTSHIFT));
+ assert((payload >> (OPpPADRANGE_COUNTSHIFT+SAVE_TIGHT_SHIFT)) == base);
+ SSCHECK(1);
+ SSPUSHUV(payload);
+
for (i = 0; i <count; i++)
- SAVECLEARSV(PAD_SVl(base+i));
+ SvPADSTALE_off(*svp++); /* mark lexical as active */
}
RETURN;
}
const bool inc =
PL_op->op_type == OP_PREINC || PL_op->op_type == OP_I_PREINC;
if (SvTYPE(TOPs) >= SVt_PVAV || (isGV_with_GP(TOPs) && !SvFAKE(TOPs)))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
if (!SvREADONLY(TOPs) && !SvGMAGICAL(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
&& SvIVX(TOPs) != (inc ? IV_MAX : IV_MIN))
{
(until such time as we get tools that can do blame annotation across
whitespace changes. */
if (gimme == G_ARRAY) {
- const I32 maxarg = AvFILL(av) + 1;
- (void)POPs; /* XXXX May be optimized away? */
- EXTEND(SP, maxarg);
- if (SvRMAGICAL(av)) {
- U32 i;
- for (i=0; i < (U32)maxarg; i++) {
- SV ** const svp = av_fetch(av, i, FALSE);
- /* See note in pp_helem, and bug id #27839 */
- SP[i+1] = svp
- ? SvGMAGICAL(*svp) ? (mg_get(*svp), *svp) : *svp
- : &PL_sv_undef;
- }
- }
- else {
- Copy(AvARRAY(av), SP+1, maxarg, SV*);
- }
- SP += maxarg;
+ SP--;
+ PUTBACK;
+ S_pushav(aTHX_ av);
+ SPAGAIN;
}
else if (gimme == G_SCALAR) {
dTARGET;
}
SvUPGRADE(sv, SVt_PV);
tmplen = SvLEN(sv); /* remember if already alloced */
- if (!tmplen && !SvREADONLY(sv)) {
+ if (!tmplen && !SvREADONLY(sv) && !SvIsCOW(sv)) {
/* try short-buffering it. Please update t/op/readline.t
* if you change the growth length.
*/
{
dVAR; dSP;
PERL_CONTEXT *cx;
- SV *sv, *oldsv;
+ SV *oldsv;
SV **itersvp;
- AV *av = NULL; /* used for LOOP_FOR on arrays and the stack */
- bool av_is_stack = FALSE;
EXTEND(SP, 1);
cx = &cxstack[cxstack_ix];
- if (!CxTYPE_is_LOOP(cx))
- DIE(aTHX_ "panic: pp_iter, type=%u", CxTYPE(cx));
-
itersvp = CxITERVAR(cx);
- if (CxTYPE(cx) == CXt_LOOP_LAZYSV) {
+
+ switch (CxTYPE(cx)) {
+ case CXt_LOOP_LAZYSV:
+ {
/* string increment */
SV* cur = cx->blk_loop.state_u.lazysv.cur;
SV *end = cx->blk_loop.state_u.lazysv.end;
It has SvPVX of "" and SvCUR of 0, which is what we want. */
STRLEN maxlen = 0;
const char *max = SvPV_const(end, maxlen);
- if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) {
- if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
- /* safe to reuse old SV */
- sv_setsv(*itersvp, cur);
- }
- else
- {
- /* we need a fresh SV every time so that loop body sees a
- * completely new SV for closures/references to work as
- * they used to */
- oldsv = *itersvp;
- *itersvp = newSVsv(cur);
- SvREFCNT_dec(oldsv);
- }
- if (strEQ(SvPVX_const(cur), max))
- sv_setiv(cur, 0); /* terminate next time */
- else
- sv_inc(cur);
- RETPUSHYES;
- }
- RETPUSHNO;
- }
- else if (CxTYPE(cx) == CXt_LOOP_LAZYIV) {
+ if (SvNIOK(cur) || SvCUR(cur) > maxlen)
+ RETPUSHNO;
+
+ if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
+ /* safe to reuse old SV */
+ sv_setsv(*itersvp, cur);
+ }
+ else
+ {
+ /* we need a fresh SV every time so that loop body sees a
+ * completely new SV for closures/references to work as
+ * they used to */
+ oldsv = *itersvp;
+ *itersvp = newSVsv(cur);
+ SvREFCNT_dec(oldsv);
+ }
+ if (strEQ(SvPVX_const(cur), max))
+ sv_setiv(cur, 0); /* terminate next time */
+ else
+ sv_inc(cur);
+ break;
+ }
+
+ case CXt_LOOP_LAZYIV:
/* integer increment */
if (cx->blk_loop.state_u.lazyiv.cur > cx->blk_loop.state_u.lazyiv.end)
RETPUSHNO;
cx->blk_loop.state_u.lazyiv.end = IV_MIN;
} else
++cx->blk_loop.state_u.lazyiv.cur;
+ break;
- RETPUSHYES;
- }
+ case CXt_LOOP_FOR:
+ {
- /* iterate array */
- assert(CxTYPE(cx) == CXt_LOOP_FOR);
- av = cx->blk_loop.state_u.ary.ary;
- if (!av) {
- av_is_stack = TRUE;
- av = PL_curstack;
- }
- if (PL_op->op_private & OPpITER_REVERSED) {
- if (cx->blk_loop.state_u.ary.ix <= (av_is_stack
- ? cx->blk_loop.resetsp + 1 : 0))
- RETPUSHNO;
+ /* iterate array */
+ AV *av = cx->blk_loop.state_u.ary.ary;
+ SV *sv;
+ bool av_is_stack = FALSE;
- if (SvMAGICAL(av) || AvREIFY(av)) {
- SV * const * const svp = av_fetch(av, --cx->blk_loop.state_u.ary.ix, FALSE);
- sv = svp ? *svp : NULL;
- }
- else {
- sv = AvARRAY(av)[--cx->blk_loop.state_u.ary.ix];
- }
- }
- else {
- if (cx->blk_loop.state_u.ary.ix >= (av_is_stack ? cx->blk_oldsp :
- AvFILL(av)))
- RETPUSHNO;
+ if (!av) {
+ av_is_stack = TRUE;
+ av = PL_curstack;
+ }
+ if (PL_op->op_private & OPpITER_REVERSED) {
+ if (cx->blk_loop.state_u.ary.ix <= (av_is_stack
+ ? cx->blk_loop.resetsp + 1 : 0))
+ RETPUSHNO;
+
+ if (SvMAGICAL(av) || AvREIFY(av)) {
+ SV * const * const svp = av_fetch(av, --cx->blk_loop.state_u.ary.ix, FALSE);
+ sv = svp ? *svp : NULL;
+ }
+ else {
+ sv = AvARRAY(av)[--cx->blk_loop.state_u.ary.ix];
+ }
+ }
+ else {
+ if (cx->blk_loop.state_u.ary.ix >= (av_is_stack ? cx->blk_oldsp :
+ AvFILL(av)))
+ RETPUSHNO;
+
+ if (SvMAGICAL(av) || AvREIFY(av)) {
+ SV * const * const svp = av_fetch(av, ++cx->blk_loop.state_u.ary.ix, FALSE);
+ sv = svp ? *svp : NULL;
+ }
+ else {
+ sv = AvARRAY(av)[++cx->blk_loop.state_u.ary.ix];
+ }
+ }
- if (SvMAGICAL(av) || AvREIFY(av)) {
- SV * const * const svp = av_fetch(av, ++cx->blk_loop.state_u.ary.ix, FALSE);
- sv = svp ? *svp : NULL;
- }
- else {
- sv = AvARRAY(av)[++cx->blk_loop.state_u.ary.ix];
- }
- }
+ if (sv && SvIS_FREED(sv)) {
+ *itersvp = NULL;
+ Perl_croak(aTHX_ "Use of freed value in iteration");
+ }
- if (sv && SvIS_FREED(sv)) {
- *itersvp = NULL;
- Perl_croak(aTHX_ "Use of freed value in iteration");
- }
+ if (sv) {
+ SvTEMP_off(sv);
+ SvREFCNT_inc_simple_void_NN(sv);
+ }
+ else
+ sv = &PL_sv_undef;
+ if (!av_is_stack && sv == &PL_sv_undef) {
+ SV *lv = newSV_type(SVt_PVLV);
+ LvTYPE(lv) = 'y';
+ sv_magic(lv, NULL, PERL_MAGIC_defelem, NULL, 0);
+ LvTARG(lv) = SvREFCNT_inc_simple(av);
+ LvTARGOFF(lv) = cx->blk_loop.state_u.ary.ix;
+ LvTARGLEN(lv) = (STRLEN)UV_MAX;
+ sv = lv;
+ }
- if (sv) {
- SvTEMP_off(sv);
- SvREFCNT_inc_simple_void_NN(sv);
- }
- else
- sv = &PL_sv_undef;
- if (!av_is_stack && sv == &PL_sv_undef) {
- SV *lv = newSV_type(SVt_PVLV);
- LvTYPE(lv) = 'y';
- sv_magic(lv, NULL, PERL_MAGIC_defelem, NULL, 0);
- LvTARG(lv) = SvREFCNT_inc_simple(av);
- LvTARGOFF(lv) = cx->blk_loop.state_u.ary.ix;
- LvTARGLEN(lv) = (STRLEN)UV_MAX;
- sv = lv;
+ oldsv = *itersvp;
+ *itersvp = sv;
+ SvREFCNT_dec(oldsv);
+ break;
}
- oldsv = *itersvp;
- *itersvp = sv;
- SvREFCNT_dec(oldsv);
-
- RETPUSHYES;
+ default:
+ DIE(aTHX_ "panic: pp_iter, type=%u", CxTYPE(cx));
+ }
+ RETPUSHYES;
}
/*
|| ( ((SvTYPE(TARG) == SVt_PVGV && isGV_with_GP(TARG))
|| SvTYPE(TARG) > SVt_PVLV)
&& !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG)))))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
PUTBACK;
s = SvPV_nomg(TARG, len);
SvGETMAGIC(sv);
if (!SvOK(sv)) {
if (SvREADONLY(sv))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
prepare_SV_for_RV(sv);
switch (to_what) {
case OPpDEREF_SV:
https://perl5.git.perl.org / perl5.git / blobdiff