X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=3d7638e5dbcb88214b2cbbea86b8b70fdc1fb991;hb=c73bb82c00a639630ef310b1ac1d896f5afcedab;hp=affea1788c782e9d947795b4bca41f068bbae3ab;hpb=d9f975991d53b93e15d703c5e48ae9aea5162637;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp.c b/pp.c
index affea17..3d7638e 100644
--- a/pp.c
+++ b/pp.c
@@ -46,7 +46,7 @@ typedef unsigned UBW;
  * have an integral type (except char) small enough to be represented
  * in a double without loss; that is, it has no 32-bit type.
  */
-#if BYTEORDER > 0xFFFF && defined(_CRAY) && !defined(_CRAYMPP)
+#if LONGSIZE > 4  && defined(_CRAY) && !defined(_CRAYMPP)
 #  define BW_BITS  32
 #  define BW_MASK  ((1 << BW_BITS) - 1)
 #  define BW_SIGN  (1 << (BW_BITS - 1))
@@ -69,7 +69,11 @@ typedef unsigned UBW;
  * If they're not right on your machine, then pack() and unpack()
  * wouldn't work right anyway; you'll need to apply the Cray hack.
  * (I'd like to check them with #if, but you can't use sizeof() in
- * the preprocessor.)
+ * the preprocessor.)  --???
+ */
+/*
+    The appropriate SHORTSIZE, INTSIZE, LONGSIZE, and LONGLONGSIZE
+    defines are now in config.h.  --Andy Dougherty  April 1998
  */
 #define SIZE16 2
 #define SIZE32 4
@@ -320,7 +324,11 @@ PP(pp_pos)
 	}
 
 	LvTYPE(TARG) = '.';
-	LvTARG(TARG) = sv;
+	if (LvTARG(TARG) != sv) {
+	    if (LvTARG(TARG))
+		SvREFCNT_dec(LvTARG(TARG));
+	    LvTARG(TARG) = SvREFCNT_inc(sv);
+	}
 	PUSHs(TARG);	/* no SvSETMAGIC */
 	RETURN;
     }
@@ -440,8 +448,13 @@ PP(pp_refgen)
 {
     djSP; dMARK;
     if (GIMME != G_ARRAY) {
-	MARK[1] = *SP;
-	SP = MARK + 1;
+	if (++MARK <= SP)
+	    *MARK = *SP;
+	else
+	    *MARK = &sv_undef;
+	*MARK = refto(*MARK);
+	SP = MARK;
+	RETURN;
     }
     EXTEND_MORTAL(SP - MARK);
     while (++MARK <= SP)
@@ -500,8 +513,14 @@ PP(pp_bless)
 
     if (MAXARG == 1)
 	stash = curcop->cop_stash;
-    else
-	stash = gv_stashsv(POPs, TRUE);
+    else {
+	SV *ssv = POPs;
+	STRLEN len;
+	char *ptr = SvPV(ssv,len);
+	if (dowarn && len == 0)
+	    warn("Explicit blessing to '' (assuming package main)");
+	stash = gv_stashpvn(ptr, len, TRUE);
+    }
 
     (void)sv_bless(TOPs, stash);
     RETURN;
@@ -756,7 +775,7 @@ PP(pp_undef)
 	hv_undef((HV*)sv);
 	break;
     case SVt_PVCV:
-	if (cv_const_sv((CV*)sv))
+	if (dowarn && cv_const_sv((CV*)sv))
 	    warn("Constant subroutine %s undefined",
 		 CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
 	/* FALL THROUGH */
@@ -767,7 +786,17 @@ PP(pp_undef)
 	break;
     case SVt_PVGV:
 	if (SvFAKE(sv))
-	    sv_setsv(sv, &sv_undef);
+	    SvSetMagicSV(sv, &sv_undef);
+	else {
+	    GP *gp;
+	    gp_free((GV*)sv);
+	    Newz(602, gp, 1, GP);
+	    GvGP(sv) = gp_ref(gp);
+	    GvSV(sv) = NEWSV(72,0);
+	    GvLINE(sv) = curcop->cop_line;
+	    GvEGV(sv) = (GV*)sv;
+	    GvMULTI_on(sv);
+	}
 	break;
     default:
 	if (SvTYPE(sv) >= SVt_PV && SvPVX(sv) && SvLEN(sv)) {
@@ -1773,47 +1802,56 @@ PP(pp_substr)
     I32 lvalue = op->op_flags & OPf_MOD;
     char *tmps;
     I32 arybase = curcop->cop_arybase;
-
-    if (MAXARG > 2)
+    char *repl = 0;
+    STRLEN repl_len;
+
+    SvTAINTED_off(TARG);			/* decontaminate */
+    if (MAXARG > 2) {
+	if (MAXARG > 3) {
+	    sv = POPs;
+	    repl = SvPV(sv, repl_len);
+	}
 	len = POPi;
+    }
     pos = POPi;
     sv = POPs;
+    PUTBACK;
     tmps = SvPV(sv, curlen);
     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 (MAXARG > 2) {
+	    if (len < 0) {
+		rem += len;
+		if (rem < 0)
+		    rem = 0;
+	    }
+	    else if (rem > len)
+		     rem = len;
+	}
     }
     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;
+	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)
+	if (dowarn || lvalue || repl)
 	    warn("substr outside of string");
 	RETPUSHUNDEF;
     }
@@ -1839,11 +1877,18 @@ PP(pp_substr)
 	    }
 
 	    LvTYPE(TARG) = 'x';
-	    LvTARG(TARG) = sv;
+	    if (LvTARG(TARG) != sv) {
+		if (LvTARG(TARG))
+		    SvREFCNT_dec(LvTARG(TARG));
+		LvTARG(TARG) = SvREFCNT_inc(sv);
+	    }
 	    LvTARGOFF(TARG) = pos;
 	    LvTARGLEN(TARG) = rem;
 	}
+	else if (repl)
+	    sv_insert(sv, pos, rem, repl, repl_len);
     }
+    SPAGAIN;
     PUSHs(TARG);		/* avoid SvSETMAGIC here */
     RETURN;
 }
@@ -1860,6 +1905,7 @@ PP(pp_vec)
     unsigned long retnum;
     I32 len;
 
+    SvTAINTED_off(TARG);			/* decontaminate */
     offset *= size;		/* turn into bit offset */
     len = (offset + size + 7) / 8;
     if (offset < 0 || size < 1)
@@ -1872,7 +1918,11 @@ PP(pp_vec)
 	    }
 
 	    LvTYPE(TARG) = 'v';
-	    LvTARG(TARG) = src;
+	    if (LvTARG(TARG) != src) {
+		if (LvTARG(TARG))
+		    SvREFCNT_dec(LvTARG(TARG));
+		LvTARG(TARG) = SvREFCNT_inc(src);
+	    }
 	    LvTARGOFF(TARG) = offset;
 	    LvTARGLEN(TARG) = size;
 	}
@@ -2359,7 +2409,6 @@ PP(pp_exists)
 PP(pp_hslice)
 {
     djSP; dMARK; dORIGMARK;
-    register HE *he;
     register HV *hv = (HV*)POPs;
     register I32 lval = op->op_flags & OPf_MOD;
     I32 realhv = (SvTYPE(hv) == SVt_PVHV);
@@ -2369,18 +2418,18 @@ PP(pp_hslice)
 	    SV *keysv = *MARK;
 	    SV **svp;
 	    if (realhv) {
-		he = hv_fetch_ent(hv, keysv, lval, 0);
+		HE *he = hv_fetch_ent(hv, keysv, lval, 0);
 		svp = he ? &HeVAL(he) : 0;
 	    } else {
 		svp = avhv_fetch_ent((AV*)hv, keysv, lval, 0);
 	    }
 	    if (lval) {
-		if (!he || HeVAL(he) == &sv_undef)
+		if (!svp || *svp == &sv_undef)
 		    DIE(no_helem, SvPV(keysv, na));
 		if (op->op_private & OPpLVAL_INTRO)
-		    save_helem(hv, keysv, &HeVAL(he));
+		    save_helem(hv, keysv, svp);
 	    }
-	    *MARK = he ? HeVAL(he) : &sv_undef;
+	    *MARK = svp ? *svp : &sv_undef;
 	}
     }
     if (GIMME != G_ARRAY) {
@@ -2485,7 +2534,7 @@ PP(pp_anonhash)
 	if (MARK < SP)
 	    sv_setsv(val, *++MARK);
 	else if (dowarn)
-	    warn("Odd number of elements in hash list");
+	    warn("Odd number of elements in hash assignment");
 	(void)hv_store_ent(hv,key,val,0);
     }
     SP = ORIGMARK;
@@ -2531,8 +2580,11 @@ PP(pp_splice)
 	    DIE(no_aelem, i);
 	if (++MARK < SP) {
 	    length = SvIVx(*MARK++);
-	    if (length < 0)
-		length = 0;
+	    if (length < 0) {
+		length += AvFILLp(ary) - offset + 1;
+		if (length < 0)
+		    length = 0;
+	    }
 	}
 	else
 	    length = AvMAX(ary) + 1;		/* close enough to infinity */
@@ -2836,11 +2888,11 @@ mul128(SV *sv, U8 m)
   U32             i = 0;
 
   if (!strnEQ(s, "0000", 4)) {  /* need to grow sv */
-    SV             *New = newSVpv("0000000000", 10);
+    SV             *tmpNew = newSVpv("0000000000", 10);
 
-    sv_catsv(New, sv);
+    sv_catsv(tmpNew, sv);
     SvREFCNT_dec(sv);		/* free old sv */
-    sv = New;
+    sv = tmpNew;
     s = SvPV(sv, len);
   }
   t = s + len - 1;
@@ -3207,6 +3259,13 @@ PP(pp_unpack)
 		    Copy(s, &aint, 1, int);
 		    s += sizeof(int);
 		    sv = NEWSV(40, 0);
+#ifdef __osf__
+                    /* Without the dummy below unpack("i", pack("i",-1))
+                     * return 0xFFffFFff instead of -1 for Digital Unix V4.0
+                     * cc with optimization turned on */
+                    (aint) ?
+		    	sv_setiv(sv, (IV)aint) :
+#endif
 		    sv_setiv(sv, (IV)aint);
 		    PUSHs(sv_2mortal(sv));
 		}
@@ -3383,6 +3442,9 @@ PP(pp_unpack)
 	    break;
 #ifdef HAS_QUAD
 	case 'q':
+	    along = (strend - s) / sizeof(Quad_t);
+	    if (len > along)
+		len = along;
 	    EXTEND(SP, len);
 	    EXTEND_MORTAL(len);
 	    while (len-- > 0) {
@@ -3401,6 +3463,9 @@ PP(pp_unpack)
 	    }
 	    break;
 	case 'Q':
+	    along = (strend - s) / sizeof(Quad_t);
+	    if (len > along)
+		len = along;
 	    EXTEND(SP, len);
 	    EXTEND_MORTAL(len);
 	    while (len-- > 0) {