Try not to use negative values when accessing arrays in C. Yet another

[p5sagit/p5-mst-13.2.git] / pp.c

diff --git a/pp.c b/pp.c
index 7a93883..025c134 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -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);
@@ -334,7 +334,7 @@ PP(pp_pos)
                I32 i = mg->mg_len;
                if (DO_UTF8(sv))
                    sv_pos_b2u(sv, &i);
-               PUSHi(i + PL_curcop->cop_arybase);
+               PUSHi(i + CopARYBASE_get(PL_curcop));
                RETURN;
            }
        }
@@ -998,7 +998,47 @@ PP(pp_pow)
 #endif    
     {
        dPOPTOPnnrl;
+
+#if defined(USE_LONG_DOUBLE) && defined(HAS_AIX_POWL_NEG_BASE_BUG)
+    /*
+    We are building perl with long double support and are on an AIX OS
+    afflicted with a powl() function that wrongly returns NaNQ for any
+    negative base.  This was reported to IBM as PMR #23047-379 on
+    03/06/2006.  The problem exists in at least the following versions
+    of AIX and the libm fileset, and no doubt others as well:
+
+       AIX 4.3.3-ML10      bos.adt.libm 4.3.3.50
+       AIX 5.1.0-ML04      bos.adt.libm 5.1.0.29
+       AIX 5.2.0           bos.adt.libm 5.2.0.85
+
+    So, until IBM fixes powl(), we provide the following workaround to
+    handle the problem ourselves.  Our logic is as follows: for
+    negative bases (left), we use fmod(right, 2) to check if the
+    exponent is an odd or even integer:
+
+       - if odd,  powl(left, right) == -powl(-left, right)
+       - if even, powl(left, right) ==  powl(-left, right)
+
+    If the exponent is not an integer, the result is rightly NaNQ, so
+    we just return that (as NV_NAN).
+    */
+
+       if (left < 0.0) {
+           NV mod2 = Perl_fmod( right, 2.0 );
+           if (mod2 == 1.0 || mod2 == -1.0) {  /* odd integer */
+               SETn( -Perl_pow( -left, right) );
+           } else if (mod2 == 0.0) {           /* even integer */
+               SETn( Perl_pow( -left, right) );
+           } else {                            /* fractional power */
+               SETn( NV_NAN );
+           }
+       } else {
+           SETn( Perl_pow( left, right) );
+       }
+#else
        SETn( Perl_pow( left, right) );
+#endif  /* HAS_AIX_POWL_NEG_BASE_BUG */
+
 #ifdef PERL_PRESERVE_IVUV
        if (is_int)
            SvIV_please(TOPs);
@@ -1714,8 +1754,15 @@ PP(pp_lt)
     }
 #endif
     {
+#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
+      dPOPTOPnnrl;
+      if (Perl_isnan(left) || Perl_isnan(right))
+         RETSETNO;
+      SETs(boolSV(left < right));
+#else
       dPOPnv;
       SETs(boolSV(TOPn < value));
+#endif
       RETURN;
     }
 }
@@ -1790,8 +1837,15 @@ PP(pp_gt)
     }
 #endif
     {
+#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
+      dPOPTOPnnrl;
+      if (Perl_isnan(left) || Perl_isnan(right))
+         RETSETNO;
+      SETs(boolSV(left > right));
+#else
       dPOPnv;
       SETs(boolSV(TOPn > value));
+#endif
       RETURN;
     }
 }
@@ -1866,8 +1920,15 @@ PP(pp_le)
     }
 #endif
     {
+#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
+      dPOPTOPnnrl;
+      if (Perl_isnan(left) || Perl_isnan(right))
+         RETSETNO;
+      SETs(boolSV(left <= right));
+#else
       dPOPnv;
       SETs(boolSV(TOPn <= value));
+#endif
       RETURN;
     }
 }
@@ -1942,8 +2003,15 @@ PP(pp_ge)
     }
 #endif
     {
+#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
+      dPOPTOPnnrl;
+      if (Perl_isnan(left) || Perl_isnan(right))
+         RETSETNO;
+      SETs(boolSV(left >= right));
+#else
       dPOPnv;
       SETs(boolSV(TOPn >= value));
+#endif
       RETURN;
     }
 }
@@ -2011,8 +2079,15 @@ PP(pp_ne)
     }
 #endif
     {
+#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
+      dPOPTOPnnrl;
+      if (Perl_isnan(left) || Perl_isnan(right))
+         RETSETYES;
+      SETs(boolSV(left != right));
+#else
       dPOPnv;
       SETs(boolSV(TOPn != value));
+#endif
       RETURN;
     }
 }
@@ -2888,7 +2963,7 @@ PP(pp_substr)
     I32 fail;
     const I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
     const char *tmps;
-    const I32 arybase = PL_curcop->cop_arybase;
+    const I32 arybase = CopARYBASE_get(PL_curcop);
     SV *repl_sv = NULL;
     const char *repl = NULL;
     STRLEN repl_len;
@@ -3089,7 +3164,7 @@ PP(pp_index)
     I32 retval;
     const char *tmps;
     const char *tmps2;
-    const I32 arybase = PL_curcop->cop_arybase;
+    const I32 arybase = CopARYBASE_get(PL_curcop);
     bool big_utf8;
     bool little_utf8;
     const bool is_index = PL_op->op_type == OP_INDEX;
@@ -3638,7 +3713,7 @@ PP(pp_aslice)
     register const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
 
     if (SvTYPE(av) == SVt_PVAV) {
-       const I32 arybase = PL_curcop->cop_arybase;
+       const I32 arybase = CopARYBASE_get(PL_curcop);
        if (lval && PL_op->op_private & OPpLVAL_INTRO) {
            register SV **svp;
            I32 max = -1;
@@ -3844,13 +3919,18 @@ 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 * const key = SvPV_const(keysv, keylen);
+                       SAVEDELETE(hv, savepvn(key,keylen),
+                                  SvUTF8(keysv) ? -keylen : keylen);
+                   }
+               }
             }
         }
         *MARK = svp ? *svp : &PL_sv_undef;
@@ -3886,7 +3966,7 @@ PP(pp_lslice)
     SV ** const lastlelem = PL_stack_base + POPMARK;
     SV ** const firstlelem = PL_stack_base + POPMARK + 1;
     register SV ** const firstrelem = lastlelem + 1;
-    const I32 arybase = PL_curcop->cop_arybase;
+    const I32 arybase = CopARYBASE_get(PL_curcop);
     I32 is_something_there = PL_op->op_flags & OPf_MOD;
 
     register const I32 max = lastrelem - lastlelem;
@@ -3994,7 +4074,7 @@ PP(pp_splice)
        if (offset < 0)
            offset += AvFILLp(ary) + 1;
        else
-           offset -= PL_curcop->cop_arybase;
+           offset -= CopARYBASE_get(PL_curcop);
        if (offset < 0)
            DIE(aTHX_ PL_no_aelem, i);
        if (++MARK < SP) {