X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=e1c9d660f7af3ac87f011706daff53c6c4b90e75;hb=333f433b6bc052819c91a73e390fb65b29161409;hp=a6f26f5c1ef7af822f7d27dd800f6820d97b306d;hpb=a5a20234c16adf3662345bdfd872d14c28021bc0;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp.c b/pp.c
index a6f26f5..e1c9d66 100644
--- a/pp.c
+++ b/pp.c
@@ -234,8 +234,8 @@ PP(pp_rv2gv)
 		if (PL_op->op_flags & OPf_REF ||
 		    PL_op->op_private & HINT_STRICT_REFS)
 		    DIE(no_usym, "a symbol");
-		if (PL_dowarn)
-		    warn(warn_uninit);
+		if (ckWARN(WARN_UNINITIALIZED))
+		    warner(WARN_UNINITIALIZED, warn_uninit);
 		RETSETUNDEF;
 	    }
 	    sym = SvPV(sv, PL_na);
@@ -278,8 +278,8 @@ PP(pp_rv2sv)
 		if (PL_op->op_flags & OPf_REF ||
 		    PL_op->op_private & HINT_STRICT_REFS)
 		    DIE(no_usym, "a SCALAR");
-		if (PL_dowarn)
-		    warn(warn_uninit);
+		if (ckWARN(WARN_UNINITIALIZED))
+		    warner(WARN_UNINITIALIZED, warn_uninit);
 		RETSETUNDEF;
 	    }
 	    sym = SvPV(sv, PL_na);
@@ -520,8 +520,9 @@ PP(pp_bless)
 	SV *ssv = POPs;
 	STRLEN len;
 	char *ptr = SvPV(ssv,len);
-	if (PL_dowarn && len == 0)
-	    warn("Explicit blessing to '' (assuming package main)");
+	if (ckWARN(WARN_UNSAFE) && len == 0)
+	    warner(WARN_UNSAFE, 
+		   "Explicit blessing to '' (assuming package main)");
 	stash = gv_stashpvn(ptr, len, TRUE);
     }
 
@@ -668,7 +669,7 @@ PP(pp_trans)
 	EXTEND(SP,1);
     }
     TARG = sv_newmortal();
-    PUSHi(do_trans(sv, PL_op));
+    PUSHi(do_trans(sv));
     RETURN;
 }
 
@@ -770,8 +771,8 @@ PP(pp_undef)
 	hv_undef((HV*)sv);
 	break;
     case SVt_PVCV:
-	if (PL_dowarn && cv_const_sv((CV*)sv))
-	    warn("Constant subroutine %s undefined",
+	if (ckWARN(WARN_UNSAFE) && cv_const_sv((CV*)sv))
+	    warner(WARN_UNSAFE, "Constant subroutine %s undefined",
 		 CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
 	/* FALL THROUGH */
     case SVt_PVFM:
@@ -1637,21 +1638,50 @@ seed(void)
 #define   SEED_C5	26107
 
     dTHR;
+#ifndef PERL_NO_DEV_RANDOM
+    int fd;
+#endif
     U32 u;
 #ifdef VMS
 #  include <starlet.h>
     /* when[] = (low 32 bits, high 32 bits) of time since epoch
      * in 100-ns units, typically incremented ever 10 ms.        */
     unsigned int when[2];
+#else
+#  ifdef HAS_GETTIMEOFDAY
+    struct timeval when;
+#  else
+    Time_t when;
+#  endif
+#endif
+
+/* This test is an escape hatch, this symbol isn't set by Configure. */
+#ifndef PERL_NO_DEV_RANDOM
+#ifndef PERL_RANDOM_DEVICE
+   /* /dev/random isn't used by default because reads from it will block
+    * if there isn't enough entropy available.  You can compile with
+    * PERL_RANDOM_DEVICE to it if you'd prefer Perl to block until there
+    * is enough real entropy to fill the seed. */
+#  define PERL_RANDOM_DEVICE "/dev/urandom"
+#endif
+    fd = PerlLIO_open(PERL_RANDOM_DEVICE, 0);
+    if (fd != -1) {
+    	if (PerlLIO_read(fd, &u, sizeof u) != sizeof u)
+	    u = 0;
+	PerlLIO_close(fd);
+	if (u)
+	    return u;
+    }
+#endif
+
+#ifdef VMS
     _ckvmssts(sys$gettim(when));
     u = (U32)SEED_C1 * when[0] + (U32)SEED_C2 * when[1];
 #else
 #  ifdef HAS_GETTIMEOFDAY
-    struct timeval when;
     gettimeofday(&when,(struct timezone *) 0);
     u = (U32)SEED_C1 * when.tv_sec + (U32)SEED_C2 * when.tv_usec;
 #  else
-    Time_t when;
     (void)time(&when);
     u = (U32)SEED_C1 * when;
 #  endif
@@ -1876,8 +1906,8 @@ PP(pp_substr)
 	rem -= pos;
     }
     if (fail < 0) {
-	if (PL_dowarn || lvalue || repl)
-	    warn("substr outside of string");
+	if (ckWARN(WARN_SUBSTR) || lvalue || repl)
+	    warner(WARN_SUBSTR, "substr outside of string");
 	RETPUSHUNDEF;
     }
     else {
@@ -1889,8 +1919,9 @@ PP(pp_substr)
 	    if (!SvGMAGICAL(sv)) {
 		if (SvROK(sv)) {
 		    SvPV_force(sv,PL_na);
-		    if (PL_dowarn)
-			warn("Attempt to use reference as lvalue in substr");
+		    if (ckWARN(WARN_SUBSTR))
+			warner(WARN_SUBSTR,
+				"Attempt to use reference as lvalue in substr");
 		}
 		if (SvOK(sv))		/* is it defined ? */
 		    (void)SvPOK_only(sv);
@@ -2096,7 +2127,7 @@ PP(pp_ord)
 {
     djSP; dTARGET;
     I32 value;
-    char *tmps = POPp;
+    U8 *tmps = (U8*)POPp;
     I32 retlen;
 
     if (IN_UTF8 && (*tmps & 0x80))
@@ -2118,7 +2149,7 @@ PP(pp_chr)
     if (IN_UTF8 && value >= 128) {
 	SvGROW(TARG,8);
 	tmps = SvPVX(TARG);
-	tmps = uv_to_utf8(tmps, (UV)value);
+	tmps = (char*)uv_to_utf8((U8*)tmps, (UV)value);
 	SvCUR_set(TARG, tmps - SvPVX(TARG));
 	*tmps = '\0';
 	(void)SvPOK_only(TARG);
@@ -2161,7 +2192,7 @@ PP(pp_ucfirst)
     register U8 *s;
     STRLEN slen;
 
-    if (IN_UTF8 && (s = SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) {
+    if (IN_UTF8 && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) {
 	I32 ulen;
 	U8 tmpbuf[10];
 	U8 *tend;
@@ -2179,12 +2210,12 @@ PP(pp_ucfirst)
 
 	if (!SvPADTMP(sv) || tend - tmpbuf != ulen) {
 	    dTARGET;
-	    sv_setpvn(TARG, tmpbuf, tend - tmpbuf);
-	    sv_catpvn(TARG, s + ulen, slen - ulen);
+	    sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
+	    sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
 	    SETs(TARG);
 	}
 	else {
-	    s = SvPV_force(sv, slen);
+	    s = (U8*)SvPV_force(sv, slen);
 	    Copy(tmpbuf, s, ulen, U8);
 	}
 	RETURN;
@@ -2196,7 +2227,7 @@ PP(pp_ucfirst)
 	sv = TARG;
 	SETs(sv);
     }
-    s = SvPV_force(sv, PL_na);
+    s = (U8*)SvPV_force(sv, PL_na);
     if (*s) {
 	if (PL_op->op_private & OPpLOCALE) {
 	    TAINT;
@@ -2217,7 +2248,7 @@ PP(pp_lcfirst)
     register U8 *s;
     STRLEN slen;
 
-    if (IN_UTF8 && (s = SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) {
+    if (IN_UTF8 && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) {
 	I32 ulen;
 	U8 tmpbuf[10];
 	U8 *tend;
@@ -2235,12 +2266,12 @@ PP(pp_lcfirst)
 
 	if (!SvPADTMP(sv) || tend - tmpbuf != ulen) {
 	    dTARGET;
-	    sv_setpvn(TARG, tmpbuf, tend - tmpbuf);
-	    sv_catpvn(TARG, s + ulen, slen - ulen);
+	    sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
+	    sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
 	    SETs(TARG);
 	}
 	else {
-	    s = SvPV_force(sv, slen);
+	    s = (U8*)SvPV_force(sv, slen);
 	    Copy(tmpbuf, s, ulen, U8);
 	}
 	RETURN;
@@ -2252,7 +2283,7 @@ PP(pp_lcfirst)
 	sv = TARG;
 	SETs(sv);
     }
-    s = SvPV_force(sv, PL_na);
+    s = (U8*)SvPV_force(sv, PL_na);
     if (*s) {
 	if (PL_op->op_private & OPpLOCALE) {
 	    TAINT;
@@ -2280,7 +2311,7 @@ PP(pp_uc)
 	register U8 *d;
 	U8 *send;
 
-	s = SvPV(sv,len);
+	s = (U8*)SvPV(sv,len);
 	if (!len) {
 	    sv_setpvn(TARG, "", 0);
 	    SETs(TARG);
@@ -2290,7 +2321,7 @@ PP(pp_uc)
 	(void)SvUPGRADE(TARG, SVt_PV);
 	SvGROW(TARG, (len * 2) + 1);
 	(void)SvPOK_only(TARG);
-	d = SvPVX(TARG);
+	d = (U8*)SvPVX(TARG);
 	send = s + len;
 	if (PL_op->op_private & OPpLOCALE) {
 	    TAINT;
@@ -2319,7 +2350,7 @@ PP(pp_uc)
 	SETs(sv);
     }
 
-    s = SvPV_force(sv, len);
+    s = (U8*)SvPV_force(sv, len);
     if (len) {
 	register U8 *send = s + len;
 
@@ -2350,7 +2381,7 @@ PP(pp_lc)
 	register U8 *d;
 	U8 *send;
 
-	s = SvPV(sv,len);
+	s = (U8*)SvPV(sv,len);
 	if (!len) {
 	    sv_setpvn(TARG, "", 0);
 	    SETs(TARG);
@@ -2360,7 +2391,7 @@ PP(pp_lc)
 	(void)SvUPGRADE(TARG, SVt_PV);
 	SvGROW(TARG, (len * 2) + 1);
 	(void)SvPOK_only(TARG);
-	d = SvPVX(TARG);
+	d = (U8*)SvPVX(TARG);
 	send = s + len;
 	if (PL_op->op_private & OPpLOCALE) {
 	    TAINT;
@@ -2389,7 +2420,7 @@ PP(pp_lc)
 	SETs(sv);
     }
 
-    s = SvPV_force(sv, len);
+    s = (U8*)SvPV_force(sv, len);
     if (len) {
 	register U8 *send = s + len;
 
@@ -2712,8 +2743,8 @@ PP(pp_anonhash)
 	SV *val = NEWSV(46, 0);
 	if (MARK < SP)
 	    sv_setsv(val, *++MARK);
-	else if (PL_dowarn)
-	    warn("Odd number of elements in hash assignment");
+	else if (ckWARN(WARN_UNSAFE))
+	    warner(WARN_UNSAFE, "Odd number of elements in hash assignment");
 	(void)hv_store_ent(hv,key,val,0);
     }
     SP = ORIGMARK;
@@ -3041,17 +3072,17 @@ PP(pp_reverse)
 	up = SvPV_force(TARG, len);
 	if (len > 1) {
 	    if (IN_UTF8) {	/* first reverse each character */
-		unsigned char* s = SvPVX(TARG);
-		unsigned char* send = s + len;
+		U8* s = (U8*)SvPVX(TARG);
+		U8* send = (U8*)(s + len);
 		while (s < send) {
 		    if (*s < 0x80) {
 			s++;
 			continue;
 		    }
 		    else {
-			up = s;
+			up = (char*)s;
 			s += UTF8SKIP(s);
-			down = s - 1;
+			down = (char*)(s - 1);
 			if (s > send || !((*down & 0xc0) == 0x80)) {
 			    warn("Malformed UTF-8 character");
 			    break;
@@ -3195,8 +3226,8 @@ PP(pp_unpack)
 	default:
 	    croak("Invalid type in unpack: '%c'", (int)datumtype);
 	case ',': /* grandfather in commas but with a warning */
-	    if (commas++ == 0 && PL_dowarn)
-		warn("Invalid type in unpack: '%c'", (int)datumtype);
+	    if (commas++ == 0 && ckWARN(WARN_UNSAFE))
+		warner(WARN_UNSAFE, "Invalid type in unpack: '%c'", (int)datumtype);
 	    break;
 	case '%':
 	    if (len == 1 && pat[-1] != '1')
@@ -3393,7 +3424,7 @@ PP(pp_unpack)
 		len = strend - s;
 	    if (checksum) {
 		while (len-- > 0 && s < strend) {
-		    auint = utf8_to_uv(s, &along);
+		    auint = utf8_to_uv((U8*)s, &along);
 		    s += along;
 		    culong += auint;
 		}
@@ -3402,7 +3433,7 @@ PP(pp_unpack)
 		EXTEND(SP, len);
 		EXTEND_MORTAL(len);
 		while (len-- > 0 && s < strend) {
-		    auint = utf8_to_uv(s, &along);
+		    auint = utf8_to_uv((U8*)s, &along);
 		    s += along;
 		    sv = NEWSV(37, 0);
 		    sv_setiv(sv, (IV)auint);
@@ -3796,7 +3827,7 @@ PP(pp_unpack)
 		char hunk[4];
 
 		hunk[3] = '\0';
-		len = (*s++ - ' ') & 077;
+		len = uudmap[*s++] & 077;
 		while (len > 0) {
 		    if (s < strend && ISUUCHAR(*s))
 			a = uudmap[*s++] & 077;
@@ -4026,8 +4057,8 @@ PP(pp_pack)
 	default:
 	    croak("Invalid type in pack: '%c'", (int)datumtype);
 	case ',': /* grandfather in commas but with a warning */
-	    if (commas++ == 0 && PL_dowarn)
-		warn("Invalid type in pack: '%c'", (int)datumtype);
+	    if (commas++ == 0 && ckWARN(WARN_UNSAFE))
+		warner(WARN_UNSAFE, "Invalid type in pack: '%c'", (int)datumtype);
 	    break;
 	case '%':
 	    DIE("%% may only be used in unpack");
@@ -4211,7 +4242,8 @@ PP(pp_pack)
 		fromstr = NEXTFROM;
 		auint = SvUV(fromstr);
 		SvGROW(cat, SvCUR(cat) + 10);
-		SvCUR_set(cat, uv_to_utf8(SvEND(cat), auint) - SvPVX(cat));
+		SvCUR_set(cat, (char*)uv_to_utf8((U8*)SvEND(cat),auint)
+			       - SvPVX(cat));
 	    }
 	    *SvEND(cat) = '\0';
 	    break;
@@ -4408,8 +4440,9 @@ PP(pp_pack)
 		     * of pack() (and all copies of the result) are
 		     * gone.
 		     */
-		    if (PL_dowarn && (SvTEMP(fromstr) || SvPADTMP(fromstr)))
-			warn("Attempt to pack pointer to temporary value");
+		    if (ckWARN(WARN_UNSAFE) && (SvTEMP(fromstr) || SvPADTMP(fromstr)))
+			warner(WARN_UNSAFE,
+				"Attempt to pack pointer to temporary value");
 		    if (SvPOK(fromstr) || SvNIOK(fromstr))
 			aptr = SvPV(fromstr,PL_na);
 		    else