This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
If the scalar has just been upgraded to SVt_RV, there's no way SvPVX
[perl5.git] / pp.c
diff --git a/pp.c b/pp.c
index 3aaad3b..6b3ead8 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -138,7 +138,7 @@ PP(pp_rv2gv)
            GV * const gv = (GV*) sv_newmortal();
            gv_init(gv, 0, "", 0, 0);
            GvIOp(gv) = (IO *)sv;
-           (void)SvREFCNT_inc(sv);
+           SvREFCNT_inc_void_NN(sv);
            sv = (SV*) gv;
        }
        else if (SvTYPE(sv) != SVt_PVGV)
@@ -172,7 +172,7 @@ PP(pp_rv2gv)
                    }
                    if (SvTYPE(sv) < SVt_RV)
                        sv_upgrade(sv, SVt_RV);
-                   if (SvPVX_const(sv)) {
+                   else if (SvPVX_const(sv)) {
                        SvPV_free(sv);
                        SvLEN_set(sv, 0);
                         SvCUR_set(sv, 0);
@@ -234,6 +234,8 @@ PP(pp_rv2sv)
        case SVt_PVAV:
        case SVt_PVHV:
        case SVt_PVCV:
+       case SVt_PVFM:
+       case SVt_PVIO:
            DIE(aTHX_ "Not a SCALAR reference");
        }
     }
@@ -320,7 +322,7 @@ PP(pp_pos)
        if (LvTARG(TARG) != sv) {
            if (LvTARG(TARG))
                SvREFCNT_dec(LvTARG(TARG));
-           LvTARG(TARG) = SvREFCNT_inc(sv);
+           LvTARG(TARG) = SvREFCNT_inc_simple(sv);
        }
        PUSHs(TARG);    /* no SvSETMAGIC */
        RETURN;
@@ -487,19 +489,19 @@ S_refto(pTHX_ SV *sv)
        if (!(sv = LvTARG(sv)))
            sv = &PL_sv_undef;
        else
-           (void)SvREFCNT_inc(sv);
+           SvREFCNT_inc_void_NN(sv);
     }
     else if (SvTYPE(sv) == SVt_PVAV) {
        if (!AvREAL((AV*)sv) && AvREIFY((AV*)sv))
            av_reify((AV*)sv);
        SvTEMP_off(sv);
-       (void)SvREFCNT_inc(sv);
+       SvREFCNT_inc_void_NN(sv);
     }
     else if (SvPADTMP(sv) && !IS_PADGV(sv))
         sv = newSVsv(sv);
     else {
        SvTEMP_off(sv);
-       (void)SvREFCNT_inc(sv);
+       SvREFCNT_inc_void_NN(sv);
     }
     rv = sv_newmortal();
     sv_upgrade(rv, SVt_RV);
@@ -637,13 +639,22 @@ PP(pp_study)
        if (SvSCREAM(sv))
            RETPUSHYES;
     }
-    else {
-       if (PL_lastscream) {
-           SvSCREAM_off(PL_lastscream);
-           SvREFCNT_dec(PL_lastscream);
-       }
-       PL_lastscream = SvREFCNT_inc(sv);
+    s = (unsigned char*)(SvPV(sv, len));
+    pos = len;
+    if (pos <= 0 || !SvPOK(sv)) {
+       /* No point in studying a zero length string, and not safe to study
+          anything that doesn't appear to be a simple scalar (and hence might
+          change between now and when the regexp engine runs without our set
+          magic ever running) such as a reference to an object with overloaded
+          stringification.  */
+       RETPUSHNO;
+    }
+
+    if (PL_lastscream) {
+       SvSCREAM_off(PL_lastscream);
+       SvREFCNT_dec(PL_lastscream);
     }
+    PL_lastscream = SvREFCNT_inc_simple(sv);
 
     s = (unsigned char*)(SvPV(sv, len));
     pos = len;
@@ -1046,6 +1057,7 @@ PP(pp_multiply)
            bhigh = blow >> (4 * sizeof (UV));
            blow &= botmask;
            if (ahigh && bhigh) {
+               /*EMPTY*/;
                /* eg 32 bit is at least 0x10000 * 0x10000 == 0x100000000
                   which is overflow. Drop to NVs below.  */
            } else if (!ahigh && !bhigh) {
@@ -2423,12 +2435,19 @@ PP(pp_i_multiply)
 
 PP(pp_i_divide)
 {
+    IV num;
     dVAR; dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
     {
       dPOPiv;
       if (value == 0)
-       DIE(aTHX_ "Illegal division by zero");
-      value = POPi / value;
+         DIE(aTHX_ "Illegal division by zero");
+      num = POPi;
+
+      /* avoid FPE_INTOVF on some platforms when num is IV_MIN */
+      if (value == -1)
+          value = - num;
+      else
+          value = num / value;
       PUSHi( value );
       RETURN;
     }
@@ -2443,7 +2462,11 @@ PP(pp_i_modulo_0)
          dPOPTOPiirl;
          if (!right)
               DIE(aTHX_ "Illegal modulus zero");
-         SETi( left % right );
+         /* avoid FPE_INTOVF on some platforms when left is IV_MIN */
+         if (right == -1)
+             SETi( 0 );
+         else
+             SETi( left % right );
          RETURN;
      }
 }
@@ -2460,7 +2483,11 @@ PP(pp_i_modulo_1)
          dPOPTOPiirl;
          if (!right)
               DIE(aTHX_ "Illegal modulus zero");
-         SETi( left % PERL_ABS(right) );
+         /* avoid FPE_INTOVF on some platforms when left is IV_MIN */
+         if (right == -1)
+             SETi( 0 );
+         else
+             SETi( left % PERL_ABS(right) );
          RETURN;
      }
 }
@@ -2501,7 +2528,11 @@ PP(pp_i_modulo)
               }
          }
 #endif
-         SETi( left % right );
+         /* avoid FPE_INTOVF on some platforms when left is IV_MIN */
+         if (right == -1)
+             SETi( 0 );
+         else
+             SETi( left % right );
          RETURN;
      }
 }
@@ -2985,7 +3016,9 @@ PP(pp_substr)
                        Perl_warner(aTHX_ packWARN(WARN_SUBSTR),
                                "Attempt to use reference as lvalue in substr");
                }
-               if (SvOK(sv))           /* is it defined ? */
+               if (isGV_with_GP(sv))
+                   SvPV_force_nolen(sv);
+               else if (SvOK(sv))      /* is it defined ? */
                    (void)SvPOK_only_UTF8(sv);
                else
                    sv_setpvn(sv,"",0); /* avoid lexical reincarnation */
@@ -3002,7 +3035,7 @@ PP(pp_substr)
            if (LvTARG(TARG) != sv) {
                if (LvTARG(TARG))
                    SvREFCNT_dec(LvTARG(TARG));
-               LvTARG(TARG) = SvREFCNT_inc(sv);
+               LvTARG(TARG) = SvREFCNT_inc_simple(sv);
            }
            LvTARGOFF(TARG) = upos;
            LvTARGLEN(TARG) = urem;
@@ -3033,7 +3066,7 @@ PP(pp_vec)
        if (LvTARG(TARG) != src) {
            if (LvTARG(TARG))
                SvREFCNT_dec(LvTARG(TARG));
-           LvTARG(TARG) = SvREFCNT_inc(src);
+           LvTARG(TARG) = SvREFCNT_inc_simple(src);
        }
        LvTARGOFF(TARG) = offset;
        LvTARGLEN(TARG) = size;
@@ -3317,7 +3350,8 @@ PP(pp_ucfirst)
            if (slen > ulen)
                sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
            SvUTF8_on(TARG);
-           SETs(TARG);
+           sv = TARG;
+           SETs(sv);
        }
        else {
            s = (U8*)SvPV_force_nomg(sv, slen);
@@ -3369,7 +3403,8 @@ PP(pp_uc)
        if (!len) {
            SvUTF8_off(TARG);                           /* decontaminate */
            sv_setpvn(TARG, "", 0);
-           SETs(TARG);
+           sv = TARG;
+           SETs(sv);
        }
        else {
            STRLEN min = len + 1;
@@ -3402,7 +3437,8 @@ PP(pp_uc)
            *d = '\0';
            SvUTF8_on(TARG);
            SvCUR_set(TARG, d - (U8*)SvPVX_const(TARG));
-           SETs(TARG);
+           sv = TARG;
+           SETs(sv);
        }
     }
     else {
@@ -3454,7 +3490,8 @@ PP(pp_lc)
        if (!len) {
            SvUTF8_off(TARG);                           /* decontaminate */
            sv_setpvn(TARG, "", 0);
-           SETs(TARG);
+           sv = TARG;
+           SETs(sv);
        }
        else {
            STRLEN min = len + 1;
@@ -3470,6 +3507,7 @@ PP(pp_lc)
 
 #define GREEK_CAPITAL_LETTER_SIGMA 0x03A3 /* Unicode U+03A3 */
                if (uv == GREEK_CAPITAL_LETTER_SIGMA) {
+                   /*EMPTY*/
                     /*
                      * Now if the sigma is NOT followed by
                      * /$ignorable_sequence$cased_letter/;
@@ -3506,7 +3544,8 @@ PP(pp_lc)
            *d = '\0';
            SvUTF8_on(TARG);
            SvCUR_set(TARG, d - (U8*)SvPVX_const(TARG));
-           SETs(TARG);
+           sv = TARG;
+           SETs(sv);
        }
     }
     else {
@@ -3805,13 +3844,17 @@ PP(pp_hslice)
                 DIE(aTHX_ PL_no_helem_sv, keysv);
             }
             if (localizing) {
-                if (preeminent)
-                    save_helem(hv, keysv, svp);
-                else {
-                    STRLEN keylen;
-                    const char *key = SvPV_const(keysv, keylen);
-                    SAVEDELETE(hv, savepvn(key,keylen), keylen);
-                }
+               if (HvNAME_get(hv) && isGV(*svp))
+                   save_gp((GV*)*svp, !(PL_op->op_flags & OPf_SPECIAL));
+               else {
+                   if (preeminent)
+                       save_helem(hv, keysv, svp);
+                   else {
+                       STRLEN keylen;
+                       const char *key = SvPV_const(keysv, keylen);
+                       SAVEDELETE(hv, savepvn(key,keylen), keylen);
+                   }
+               }
             }
         }
         *MARK = svp ? *svp : &PL_sv_undef;
@@ -4231,7 +4274,8 @@ PP(pp_reverse)
            sv_setsv(TARG, (SP > MARK)
                    ? *SP
                    : (padoff_du = find_rundefsvoffset(),
-                       (padoff_du == NOT_IN_PAD || PAD_COMPNAME_FLAGS(padoff_du) & SVpad_OUR)
+                       (padoff_du == NOT_IN_PAD
+                        || PAD_COMPNAME_FLAGS_isOUR(padoff_du))
                        ? DEFSV : PAD_SVl(padoff_du)));
        up = SvPV_force(TARG, len);
        if (len > 1) {
@@ -4298,7 +4342,7 @@ PP(pp_split)
     const I32 oldsave = PL_savestack_ix;
     I32 make_mortal = 1;
     bool multiline = 0;
-    MAGIC *mg = (MAGIC *) NULL;
+    MAGIC *mg = NULL;
 
 #ifdef DEBUGGING
     Copy(&LvTARGOFF(POPs), &pm, 1, PMOP*);