[inseperable differences to perl 5.004_03]

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

diff --git a/pp.c b/pp.c
index 68b0991..8a31fff 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -16,6 +16,17 @@
 #include "perl.h"
 
 /*
+ * The compiler on Concurrent CX/UX systems has a subtle bug which only
+ * seems to show up when compiling pp.c - it generates the wrong double
+ * precision constant value for (double)UV_MAX when used inline in the body
+ * of the code below, so this makes a static variable up front (which the
+ * compiler seems to get correct) and uses it in place of UV_MAX below.
+ */
+#ifdef CXUX_BROKEN_CONSTANT_CONVERT
+static double UV_MAX_cxux = ((double)UV_MAX);
+#endif
+
+/*
  * Types used in bitwise operations.
  *
  * Normally we'd just use IV and UV.  However, some hardware and
@@ -178,7 +189,7 @@ PP(pp_rv2gv)
            GV *gv = (GV*) sv_newmortal();
            gv_init(gv, 0, "", 0, 0);
            GvIOp(gv) = (IO *)sv;
-           SvREFCNT_inc(sv);
+           (void)SvREFCNT_inc(sv);
            sv = (SV*) gv;
        } else if (SvTYPE(sv) != SVt_PVGV)
            DIE("Not a GLOB reference");
@@ -776,6 +787,8 @@ PP(pp_modulo)
       if ((left_neg != right_neg) && ans)
        ans = right - ans;
       if (right_neg) {
+       /* XXX may warn: unary minus operator applied to unsigned type */
+       /* could change -foo to be (~foo)+1 instead     */
        if (ans <= -(UV)IV_MAX)
          sv_setiv(TARG, (IV) -ans);
        else
@@ -1617,37 +1630,56 @@ PP(pp_substr)
     STRLEN curlen;
     I32 pos;
     I32 rem;
+    I32 fail;
     I32 lvalue = op->op_flags & OPf_MOD;
     char *tmps;
     I32 arybase = curcop->cop_arybase;
 
     if (MAXARG > 2)
        len = POPi;
-    pos = POPi - arybase;
+    pos = POPi;
     sv = POPs;
     tmps = SvPV(sv, curlen);
-    if (pos < 0) {
-       pos += curlen + arybase;
-       if (pos < 0 && MAXARG < 3)
-           pos = 0;
+    if (pos >= arybase) {
+       pos -= arybase;
+       rem = curlen-pos;
+       fail = rem;
+        if (MAXARG > 2) {
+            if (len < 0) {
+               rem += len;
+                if (rem < 0)
+                    rem = 0;
+            }
+            else if (rem > len)
+                     rem = len;
+        }
     }
-    if (pos < 0 || pos > curlen) {
-       if (dowarn || lvalue)
+    else {
+        pos += curlen;
+        if (MAXARG < 3)
+            rem = curlen;
+        else if (len >= 0) {
+            rem = pos+len;
+            if (rem > (I32)curlen)
+                rem = curlen;
+        }
+        else {
+            rem = curlen+len;
+            if (rem < pos)
+                rem = pos;
+        }
+        if (pos < 0)
+            pos = 0;
+        fail = rem;
+        rem -= pos;
+    }
+    if (fail < 0) {
+       if (dowarn || lvalue) 
            warn("substr outside of string");
        RETPUSHUNDEF;
     }
     else {
-       if (MAXARG < 3)
-           len = curlen;
-       else if (len < 0) {
-           len += curlen - pos;
-           if (len < 0)
-               len = 0;
-       }
        tmps += pos;
-       rem = curlen - pos;     /* rem=how many bytes left*/
-       if (rem > len)
-           rem = len;
        sv_setpvn(TARG, tmps, rem);
        if (lvalue) {                   /* it's an lvalue! */
            if (!SvGMAGICAL(sv)) {
@@ -2318,11 +2350,13 @@ PP(pp_splice)
     SP++;
 
     if (++MARK < SP) {
-       offset = SvIVx(*MARK);
+       offset = i = SvIVx(*MARK);
        if (offset < 0)
            offset += AvFILL(ary) + 1;
        else
            offset -= curcop->cop_arybase;
+       if (offset < 0)
+           DIE(no_aelem, i);
        if (++MARK < SP) {
            length = SvIVx(*MARK++);
            if (length < 0)
@@ -2335,12 +2369,6 @@ PP(pp_splice)
        offset = 0;
        length = AvMAX(ary) + 1;
     }
-    if (offset < 0) {
-       length += offset;
-       offset = 0;
-       if (length < 0)
-           length = 0;
-    }
     if (offset > AvFILL(ary) + 1)
        offset = AvFILL(ary) + 1;
     after = AvFILL(ary) + 1 - (offset + length);
@@ -3114,7 +3142,7 @@ PP(pp_unpack)
                    else if (++bytes >= sizeof(UV)) {   /* promote to string */
                        char *t;
 
-                       sv = newSVpvf("%0*vu", (int)(sizeof(UV) * 3), auv);
+                       sv = newSVpvf("%.*Vu", (int)TYPE_DIGITS(UV), auv);
                        while (s < strend) {
                            sv = mul128(sv, *s & 0x7f);
                            if (!(*s++ & 0x80)) {
@@ -3715,8 +3743,12 @@ PP(pp_pack)
 #ifdef BW_BITS
                    adouble <= BW_MASK
 #else
+#ifdef CXUX_BROKEN_CONSTANT_CONVERT
+                   adouble <= UV_MAX_cxux
+#else
                    adouble <= UV_MAX
 #endif
+#endif
                    )
                {
                    char   buf[1 + sizeof(UV)];
@@ -3832,7 +3864,21 @@ PP(pp_pack)
        case 'p':
            while (len-- > 0) {
                fromstr = NEXTFROM;
-               aptr = SvPV_force(fromstr, na); /* XXX Error if TEMP? */
+               if (fromstr == &sv_undef)
+                   aptr = NULL;
+               else {
+                   /* XXX better yet, could spirit away the string to
+                    * a safe spot and hang on to it until the result
+                    * of pack() (and all copies of the result) are
+                    * gone.
+                    */
+                   if (dowarn && (SvTEMP(fromstr) || SvPADTMP(fromstr)))
+                       warn("Attempt to pack pointer to temporary value");
+                   if (SvPOK(fromstr) || SvNIOK(fromstr))
+                       aptr = SvPV(fromstr,na);
+                   else
+                       aptr = SvPV_force(fromstr,na);
+               }
                sv_catpvn(cat, (char*)&aptr, sizeof(char*));
            }
            break;