To make arithmetic on tainted dualvars work properly requires that

[perl5.git] / pp.c

diff --git a/pp.c b/pp.c
index 8d6421c..f9f9e7b 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -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");
        }
     }
@@ -771,7 +773,7 @@ PP(pp_undef)
        if (cv_const_sv((CV*)sv) && ckWARN(WARN_MISC))
            Perl_warner(aTHX_ packWARN(WARN_MISC), "Constant subroutine %s undefined",
                 CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
-       /* FALL THROUGH */
+       /* FALLTHROUGH */
     case SVt_PVFM:
        {
            /* let user-undef'd sub keep its identity */
@@ -1046,6 +1048,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) {
@@ -2205,50 +2208,32 @@ PP(pp_bit_and)
     }
 }
 
-PP(pp_bit_xor)
-{
-    dVAR; dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
-    {
-      dPOPTOPssrl;
-      SvGETMAGIC(left);
-      SvGETMAGIC(right);
-      if (SvNIOKp(left) || SvNIOKp(right)) {
-       if (PL_op->op_private & HINT_INTEGER) {
-         const IV i = (USE_LEFT(left) ? SvIV_nomg(left) : 0) ^ SvIV_nomg(right);
-         SETi(i);
-       }
-       else {
-         const UV u = (USE_LEFT(left) ? SvUV_nomg(left) : 0) ^ SvUV_nomg(right);
-         SETu(u);
-       }
-      }
-      else {
-       do_vop(PL_op->op_type, TARG, left, right);
-       SETTARG;
-      }
-      RETURN;
-    }
-}
-
 PP(pp_bit_or)
 {
-    dVAR; dSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
+    dVAR; dSP; dATARGET;
+    const int op_type = PL_op->op_type;
+
+    tryAMAGICbin_var((op_type == OP_BIT_OR ? bor_amg : bxor_amg), opASSIGN);
     {
       dPOPTOPssrl;
       SvGETMAGIC(left);
       SvGETMAGIC(right);
       if (SvNIOKp(left) || SvNIOKp(right)) {
        if (PL_op->op_private & HINT_INTEGER) {
-         const IV i = (USE_LEFT(left) ? SvIV_nomg(left) : 0) | SvIV_nomg(right);
-         SETi(i);
+         const IV l = (USE_LEFT(left) ? SvIV_nomg(left) : 0);
+         const IV r = SvIV_nomg(right);
+         const IV result = op_type == OP_BIT_OR ? (l | r) : (l ^ r);
+         SETi(result);
        }
        else {
-         const UV u = (USE_LEFT(left) ? SvUV_nomg(left) : 0) | SvUV_nomg(right);
-         SETu(u);
+         const UV l = (USE_LEFT(left) ? SvUV_nomg(left) : 0);
+         const UV r = SvUV_nomg(right);
+         const UV result = op_type == OP_BIT_OR ? (l | r) : (l ^ r);
+         SETu(result);
        }
       }
       else {
-       do_vop(PL_op->op_type, TARG, left, right);
+       do_vop(op_type, TARG, left, right);
        SETTARG;
       }
       RETURN;
@@ -2441,12 +2426,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;
     }
@@ -2461,7 +2453,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;
      }
 }
@@ -2478,7 +2474,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;
      }
 }
@@ -2519,7 +2519,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;
      }
 }
@@ -2646,26 +2650,26 @@ PP(pp_sin)
     dVAR; dSP; dTARGET;
     int amg_type = sin_amg;
     const char *neg_report = NULL;
-    NV (*func)(NV) = &Perl_sin;
+    NV (*func)(NV) = Perl_sin;
     const int op_type = PL_op->op_type;
 
     switch (op_type) {
     case OP_COS:
        amg_type = cos_amg;
-       func = &Perl_cos;
+       func = Perl_cos;
        break;
     case OP_EXP:
        amg_type = exp_amg;
-       func = &Perl_exp;
+       func = Perl_exp;
        break;
     case OP_LOG:
        amg_type = log_amg;
-       func = &Perl_log;
+       func = Perl_log;
        neg_report = "log";
        break;
     case OP_SQRT:
        amg_type = sqrt_amg;
-       func = &Perl_sqrt;
+       func = Perl_sqrt;
        neg_report = "sqrt";
        break;
     }
@@ -3488,6 +3492,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/;
@@ -4184,8 +4189,7 @@ PP(pp_shift)
     AV * const av = (AV*)POPs;
     SV * const sv = PL_op->op_type == OP_SHIFT ? av_shift(av) : av_pop(av);
     EXTEND(SP, 1);
-    if (!sv)
-       RETPUSHUNDEF;
+    assert (sv);
     if (AvREAL(av))
        (void)sv_2mortal(sv);
     PUSHs(sv);