X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=60eaf2867ad62a9a114b0d9421e445ae5bc49ee4;hb=8b0ac1d72e8a6530ddcafe41734c2fd10d6cbe5a;hp=53c7162915a9acae9b32b6962b60ed6b77f98fc5;hpb=58a9d1fc4b9782cdc8aaf9dd6fdfa2736076b173;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp.c b/pp.c index 53c7162..60eaf28 100644 --- a/pp.c +++ b/pp.c @@ -168,6 +168,12 @@ PP(pp_rv2gv) } if (SvTYPE(sv) < SVt_RV) sv_upgrade(sv, SVt_RV); + if (SvPVX(sv)) { + (void)SvOOK_off(sv); /* backoff */ + if (SvLEN(sv)) + Safefree(SvPVX(sv)); + SvLEN(sv)=SvCUR(sv)=0; + } SvRV(sv) = (SV*)gv; SvROK_on(sv); SvSETMAGIC(sv); @@ -177,7 +183,7 @@ PP(pp_rv2gv) PL_op->op_private & HINT_STRICT_REFS) DIE(aTHX_ PL_no_usym, "a symbol"); if (ckWARN(WARN_UNINITIALIZED)) - report_uninit(); + report_uninit(sv); RETSETUNDEF; } sym = SvPV(sv,len); @@ -238,7 +244,7 @@ PP(pp_rv2sv) PL_op->op_private & HINT_STRICT_REFS) DIE(aTHX_ PL_no_usym, "a SCALAR"); if (ckWARN(WARN_UNINITIALIZED)) - report_uninit(); + report_uninit(sv); RETSETUNDEF; } sym = SvPV(sv, len); @@ -1386,11 +1392,8 @@ PP(pp_repeat) dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN); { register IV count = POPi; - if (count < 0) { - if (ckWARN(WARN_MISC)) - Perl_warner(aTHX_ packWARN(WARN_MISC), "Negative repeat count"); + if (count < 0) count = 0; - } if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) { dMARK; I32 items = SP - MARK; @@ -2797,7 +2800,9 @@ PP(pp_int) else preferring IV has introduced a subtle behaviour change bug. OTOH relying on floating point to be accurate is a bug. */ - if (SvIOK(TOPs)) { + if (!SvOK(TOPs)) + SETu(0); + else if (SvIOK(TOPs)) { if (SvIsUV(TOPs)) { UV uv = TOPu; SETu(uv); @@ -2831,7 +2836,9 @@ PP(pp_abs) /* This will cache the NV value if string isn't actually integer */ IV iv = TOPi; - if (SvIOK(TOPs)) { + if (!SvOK(TOPs)) + SETu(0); + else if (SvIOK(TOPs)) { /* IVX is precise */ if (SvIsUV(TOPs)) { SETu(TOPu); /* force it to be numeric only */ @@ -3041,6 +3048,19 @@ PP(pp_substr) if (utf8_curlen) sv_pos_u2b(sv, &pos, &rem); tmps += pos; + /* we either return a PV or an LV. If the TARG hasn't been used + * before, or is of that type, reuse it; otherwise use a mortal + * instead. Note that LVs can have an extended lifetime, so also + * dont reuse if refcount > 1 (bug #20933) */ + if (SvTYPE(TARG) > SVt_NULL) { + if ( (SvTYPE(TARG) == SVt_PVLV) + ? (!lvalue || SvREFCNT(TARG) > 1) + : lvalue) + { + TARG = sv_newmortal(); + } + } + sv_setpvn(TARG, tmps, rem); #ifdef USE_LOCALE_COLLATE sv_unmagic(TARG, PERL_MAGIC_collxfrm); @@ -3077,8 +3097,6 @@ PP(pp_substr) sv_setpvn(sv,"",0); /* avoid lexical reincarnation */ } - if (SvREFCNT(TARG) > 1) /* don't share the TARG (#20933) */ - TARG = sv_newmortal(); if (SvTYPE(TARG) < SVt_PVLV) { sv_upgrade(TARG, SVt_PVLV); sv_magic(TARG, Nullsv, PERL_MAGIC_substr, Nullch, 0); @@ -3781,7 +3799,10 @@ PP(pp_delete) SP = ORIGMARK; else if (gimme == G_SCALAR) { MARK = ORIGMARK; - *++MARK = *SP; + if (SP > MARK) + *++MARK = *SP; + else + *++MARK = &PL_sv_undef; SP = MARK; } } @@ -4622,7 +4643,7 @@ PP(pp_split) if (TOPs && !make_mortal) sv_2mortal(TOPs); iters--; - SP--; + *SP-- = &PL_sv_undef; } }