X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=07bb33d367add9720dfe56396c8ad45a7bec8f46;hb=564319723c2c18fa4801cd77e0d203a582b4d5a3;hp=770b07d8bb266e44b1473ecb2ce621de38f63247;hpb=252aa0820e6bce274b33bd342cfc65e18a59a165;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp.c b/pp.c
index 770b07d..07bb33d 100644
--- a/pp.c
+++ b/pp.c
@@ -406,6 +406,8 @@ PP(pp_rv2cv)
     if (cv) {
 	if (CvCLONE(cv))
 	    cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
+	if ((PL_op->op_private & OPpLVAL_INTRO) && !CvLVALUE(cv))
+	    Perl_croak(aTHX_ "Can't modify non-lvalue subroutine call");
     }
     else
 	cv = (CV*)&PL_sv_undef;
@@ -1776,9 +1778,9 @@ S_seed(pTHX)
 #  endif
 #endif
     u += SEED_C3 * (U32)getpid();
-    u += SEED_C4 * (U32)(UV)PL_stack_sp;
+    u += SEED_C4 * (U32)PTR2UV(PL_stack_sp);
 #ifndef PLAN9           /* XXX Plan9 assembler chokes on this; fix needed  */
-    u += SEED_C5 * (U32)(UV)&when;
+    u += SEED_C5 * (U32)PTR2UV(&when);
 #endif
     return u;
 }
@@ -1885,14 +1887,14 @@ PP(pp_hex)
     STRLEN n_a;
 
     tmps = POPpx;
-    XPUSHu(scan_hex(tmps, sizeof(UV) * 2 + 1, &argtype));
+    XPUSHn(scan_hex(tmps, 99, &argtype));
     RETURN;
 }
 
 PP(pp_oct)
 {
     djSP; dTARGET;
-    UV value;
+    NV value;
     I32 argtype;
     char *tmps;
     STRLEN n_a;
@@ -1900,15 +1902,15 @@ PP(pp_oct)
     tmps = POPpx;
     while (*tmps && isSPACE(*tmps))
 	tmps++;
-    /* Do not eat the leading 0[bx] because we need them
-     * to detect malformed binary and hexadecimal numbers. */
-    if ((tmps[0] == '0' && tmps[1] == 'x') || tmps[0] == 'x')
-	value = scan_hex(tmps, sizeof(UV) * 2 + 1, &argtype);
-    else if ((tmps[0] == '0' && tmps[1] == 'b') || tmps[0] == 'b')
-	value = scan_bin(tmps, sizeof(UV) * 8 + 1, &argtype);
+    if (*tmps == '0')
+	tmps++;
+    if (*tmps == 'x')
+	value = scan_hex(++tmps, 99, &argtype);
+    else if (*tmps == 'b')
+	value = scan_bin(++tmps, 99, &argtype);
     else
-	value = scan_oct(tmps, sizeof(UV) * 4 + 1, &argtype);
-    XPUSHu(value);
+	value = scan_oct(tmps, 99, &argtype);
+    XPUSHn(value);
     RETURN;
 }
 
@@ -2052,74 +2054,24 @@ PP(pp_vec)
     register I32 offset = POPi;
     register SV *src = POPs;
     I32 lvalue = PL_op->op_flags & OPf_MOD;
-    STRLEN srclen;
-    unsigned char *s = (unsigned char*)SvPV(src, srclen);
-    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)
-	retnum = 0;
-    else {
-	if (lvalue) {                      /* it's an lvalue! */
-	    if (SvTYPE(TARG) < SVt_PVLV) {
-		sv_upgrade(TARG, SVt_PVLV);
-		sv_magic(TARG, Nullsv, 'v', Nullch, 0);
-	    }
 
-	    LvTYPE(TARG) = 'v';
-	    if (LvTARG(TARG) != src) {
-		if (LvTARG(TARG))
-		    SvREFCNT_dec(LvTARG(TARG));
-		LvTARG(TARG) = SvREFCNT_inc(src);
-	    }
-	    LvTARGOFF(TARG) = offset;
-	    LvTARGLEN(TARG) = size;
-	}
-	if (len > srclen) {
-	    if (size <= 8)
-		retnum = 0;
-	    else {
-		offset >>= 3;
-		if (size == 16) {
-		    if (offset >= srclen)
-			retnum = 0;
-		    else
-			retnum = (unsigned long) s[offset] << 8;
-		}
-		else if (size == 32) {
-		    if (offset >= srclen)
-			retnum = 0;
-		    else if (offset + 1 >= srclen)
-			retnum = (unsigned long) s[offset] << 24;
-		    else if (offset + 2 >= srclen)
-			retnum = ((unsigned long) s[offset] << 24) +
-			    ((unsigned long) s[offset + 1] << 16);
-		    else
-			retnum = ((unsigned long) s[offset] << 24) +
-			    ((unsigned long) s[offset + 1] << 16) +
-			    (s[offset + 2] << 8);
-		}
-	    }
+    SvTAINTED_off(TARG);		/* decontaminate */
+    if (lvalue) {			/* it's an lvalue! */
+	if (SvTYPE(TARG) < SVt_PVLV) {
+	    sv_upgrade(TARG, SVt_PVLV);
+	    sv_magic(TARG, Nullsv, 'v', Nullch, 0);
 	}
-	else if (size < 8)
-	    retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
-	else {
-	    offset >>= 3;
-	    if (size == 8)
-		retnum = s[offset];
-	    else if (size == 16)
-		retnum = ((unsigned long) s[offset] << 8) + s[offset+1];
-	    else if (size == 32)
-		retnum = ((unsigned long) s[offset] << 24) +
-			((unsigned long) s[offset + 1] << 16) +
-			(s[offset + 2] << 8) + s[offset+3];
+	LvTYPE(TARG) = 'v';
+	if (LvTARG(TARG) != src) {
+	    if (LvTARG(TARG))
+		SvREFCNT_dec(LvTARG(TARG));
+	    LvTARG(TARG) = SvREFCNT_inc(src);
 	}
+	LvTARGOFF(TARG) = offset;
+	LvTARGLEN(TARG) = size;
     }
 
-    sv_setuv(TARG, (UV)retnum);
+    sv_setuv(TARG, do_vecget(src, offset, size));
     PUSHs(TARG);
     RETURN;
 }
@@ -3350,8 +3302,11 @@ PP(pp_unpack)
 	}
 	else if (isDIGIT(*pat)) {
 	    len = *pat++ - '0';
-	    while (isDIGIT(*pat))
+	    while (isDIGIT(*pat)) {
 		len = (len * 10) + (*pat++ - '0');
+		if (len < 0)
+		    Perl_croak(aTHX_ "Repeat count in unpack overflows");
+	    }
 	}
 	else
 	    len = (datumtype != '@');
@@ -3608,6 +3563,7 @@ PP(pp_unpack)
 	    if (checksum) {
 #if SHORTSIZE != SIZE16
 		if (natint) {
+		    short ashort;
 		    while (len-- > 0) {
 			COPYNN(s, &ashort, sizeof(short));
 			s += sizeof(short);
@@ -3634,6 +3590,7 @@ PP(pp_unpack)
 		EXTEND_MORTAL(len);
 #if SHORTSIZE != SIZE16
 		if (natint) {
+		    short ashort;
 		    while (len-- > 0) {
 			COPYNN(s, &ashort, sizeof(short));
 			s += sizeof(short);
@@ -3673,6 +3630,7 @@ PP(pp_unpack)
 	    if (checksum) {
 #if SHORTSIZE != SIZE16
 		if (unatint) {
+		    unsigned short aushort;
 		    while (len-- > 0) {
 			COPYNN(s, &aushort, sizeof(unsigned short));
 			s += sizeof(unsigned short);
@@ -3702,6 +3660,7 @@ PP(pp_unpack)
 		EXTEND_MORTAL(len);
 #if SHORTSIZE != SIZE16
 		if (unatint) {
+		    unsigned short aushort;
 		    while (len-- > 0) {
 			COPYNN(s, &aushort, sizeof(unsigned short));
 			s += sizeof(unsigned short);
@@ -3826,6 +3785,7 @@ PP(pp_unpack)
 	    if (checksum) {
 #if LONGSIZE != SIZE32
 		if (natint) {
+		    long along;
 		    while (len-- > 0) {
 			COPYNN(s, &along, sizeof(long));
 			s += sizeof(long);
@@ -3857,6 +3817,7 @@ PP(pp_unpack)
 		EXTEND_MORTAL(len);
 #if LONGSIZE != SIZE32
 		if (natint) {
+		    long along;
 		    while (len-- > 0) {
 			COPYNN(s, &along, sizeof(long));
 			s += sizeof(long);
@@ -3896,6 +3857,7 @@ PP(pp_unpack)
 	    if (checksum) {
 #if LONGSIZE != SIZE32
 		if (unatint) {
+		    unsigned long aulong;
 		    while (len-- > 0) {
 			COPYNN(s, &aulong, sizeof(unsigned long));
 			s += sizeof(unsigned long);
@@ -3931,6 +3893,7 @@ PP(pp_unpack)
 		EXTEND_MORTAL(len);
 #if LONGSIZE != SIZE32
 		if (unatint) {
+		    unsigned long aulong;
 		    while (len-- > 0) {
 			COPYNN(s, &aulong, sizeof(unsigned long));
 			s += sizeof(unsigned long);
@@ -4394,8 +4357,11 @@ PP(pp_pack)
 	}
 	else if (isDIGIT(*pat)) {
 	    len = *pat++ - '0';
-	    while (isDIGIT(*pat))
+	    while (isDIGIT(*pat)) {
 		len = (len * 10) + (*pat++ - '0');
+		if (len < 0)
+		    Perl_croak(aTHX_ "Repeat count in pack overflows");
+	    }
 	}
 	else
 	    len = 1;
@@ -4666,6 +4632,8 @@ PP(pp_pack)
 	case 's':
 #if SHORTSIZE != SIZE16
 	    if (natint) {
+		short ashort;
+
 		while (len-- > 0) {
 		    fromstr = NEXTFROM;
 		    ashort = SvIV(fromstr);
@@ -4789,6 +4757,8 @@ PP(pp_pack)
 	case 'L':
 #if LONGSIZE != SIZE32
 	    if (natint) {
+		unsigned long aulong;
+
 		while (len-- > 0) {
 		    fromstr = NEXTFROM;
 		    aulong = SvUV(fromstr);
@@ -4808,6 +4778,8 @@ PP(pp_pack)
 	case 'l':
 #if LONGSIZE != SIZE32
 	    if (natint) {
+		long along;
+
 		while (len-- > 0) {
 		    fromstr = NEXTFROM;
 		    along = SvIV(fromstr);
@@ -4828,7 +4800,7 @@ PP(pp_pack)
 	case 'Q':
 	    while (len-- > 0) {
 		fromstr = NEXTFROM;
-		auquad = (Uquad_t)SvIV(fromstr);
+		auquad = (Uquad_t)SvUV(fromstr);
 		sv_catpvn(cat, (char*)&auquad, sizeof(Uquad_t));
 	    }
 	    break;
@@ -4957,6 +4929,7 @@ PP(pp_split)
 	else {
 	    if (!AvREAL(ary)) {
 		AvREAL_on(ary);
+		AvREIFY_off(ary);
 		for (i = AvFILLp(ary); i >= 0; i--)
 		    AvARRAY(ary)[i] = &PL_sv_undef;	/* don't free mere refs */
 	    }