Make the dUNDERBAR/UNDERBAR macros work as advertised.

[perl5.git] / pp.c

diff --git a/pp.c b/pp.c
index 8b485fd..c0c7420 100644 (file)
--- 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,6 +1392,8 @@ PP(pp_repeat)
   dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
   {
     register IV count = POPi;
+    if (count < 0)
+       count = 0;
     if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
        dMARK;
        I32 items = SP - MARK;
@@ -2377,6 +2385,7 @@ PP(pp_complement)
        register I32 anum;
        STRLEN len;
 
+       (void)SvPV_nomg(sv,len); /* force check for uninit var */
        sv_setsv_nomg(TARG, sv);
        tmps = (U8*)SvPV_force(TARG, len);
        anum = len;
@@ -2791,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);
@@ -2825,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 */
@@ -3035,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);
@@ -3071,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);
@@ -3775,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;
        }
     }
@@ -4307,12 +4334,17 @@ PP(pp_reverse)
        register I32 tmp;
        dTARGET;
        STRLEN len;
+       I32 padoff_du;
 
        SvUTF8_off(TARG);                               /* decontaminate */
        if (SP - MARK > 1)
            do_join(TARG, &PL_sv_no, MARK, SP);
        else
-           sv_setsv(TARG, (SP > MARK) ? *SP : DEFSV);
+           sv_setsv(TARG, (SP > MARK)
+                   ? *SP
+                   : (padoff_du = Perl_find_rundefsvoffset(),
+                       (padoff_du == NOT_IN_PAD || PAD_COMPNAME_FLAGS(padoff_du) & SVpad_OUR)
+                       ? DEFSV : PAD_SVl(padoff_du)));
        up = SvPV_force(TARG, len);
        if (len > 1) {
            if (DO_UTF8(TARG)) {        /* first reverse each character */
@@ -4616,7 +4648,7 @@ PP(pp_split)
            if (TOPs && !make_mortal)
                sv_2mortal(TOPs);
            iters--;
-           SP--;
+           *SP-- = &PL_sv_undef;
        }
     }