X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=8a31fff8812e3a850830682b989c9815c8aaac53;hb=90248788f819cf7b59aabb5259fdd6d66bc4632b;hp=f7f0c412a688115f6afd797e9f982bc0c17325bf;hpb=fc36a67e8855d031b2a6921819d899eb149eee2d;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp.c b/pp.c
index f7f0c41..8a31fff 100644
--- 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);
@@ -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;