X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/943fd1546636339d357c1308842dbd5454a3c2a1..2baadb76de5602fd6919cac96dea41124e89d11a:/util.c

diff --git a/util.c b/util.c
index f75f938..4a1a45f 100644
--- a/util.c
+++ b/util.c
@@ -1033,6 +1033,7 @@ Perl_vdie(pTHX_ const char* pat, va_list *args)
     CV *cv;
     SV *msv;
     STRLEN msglen;
+    I32 utf8 = 0;
 
     DEBUG_S(PerlIO_printf(Perl_debug_log,
 			  "%p: die: curstack = %p, mainstack = %p\n",
@@ -1047,6 +1048,7 @@ Perl_vdie(pTHX_ const char* pat, va_list *args)
 	}
 	else
 	    message = SvPV(msv,msglen);
+	utf8 = SvUTF8(msv);
     }
     else {
 	message = Nullch;
@@ -1072,6 +1074,7 @@ Perl_vdie(pTHX_ const char* pat, va_list *args)
 	    save_re_context();
 	    if (message) {
 		msg = newSVpvn(message, msglen);
+		SvFLAGS(msg) |= utf8;
 		SvREADONLY_on(msg);
 		SAVEFREESV(msg);
 	    }
@@ -1090,6 +1093,7 @@ Perl_vdie(pTHX_ const char* pat, va_list *args)
     }
 
     PL_restartop = die_where(message, msglen);
+    SvFLAGS(ERRSV) |= utf8;
     DEBUG_S(PerlIO_printf(Perl_debug_log,
 	  "%p: die: restartop = %p, was_in_eval = %d, top_env = %p\n",
 	  thr, PL_restartop, was_in_eval, PL_top_env));
@@ -1132,6 +1136,7 @@ Perl_vcroak(pTHX_ const char* pat, va_list *args)
     CV *cv;
     SV *msv;
     STRLEN msglen;
+    I32 utf8 = 0;
 
     if (pat) {
 	msv = vmess(pat, args);
@@ -1142,6 +1147,7 @@ Perl_vcroak(pTHX_ const char* pat, va_list *args)
 	}
 	else
 	    message = SvPV(msv,msglen);
+	utf8 = SvUTF8(msv);
     }
     else {
 	message = Nullch;
@@ -1167,6 +1173,7 @@ Perl_vcroak(pTHX_ const char* pat, va_list *args)
 	    save_re_context();
 	    if (message) {
 		msg = newSVpvn(message, msglen);
+		SvFLAGS(msg) |= utf8;
 		SvREADONLY_on(msg);
 		SAVEFREESV(msg);
 	    }
@@ -1185,6 +1192,7 @@ Perl_vcroak(pTHX_ const char* pat, va_list *args)
     }
     if (PL_in_eval) {
 	PL_restartop = die_where(message, msglen);
+	SvFLAGS(ERRSV) |= utf8;
 	JMPENV_JUMP(3);
     }
     else if (!message)
@@ -1245,8 +1253,10 @@ Perl_vwarn(pTHX_ const char* pat, va_list *args)
     CV *cv;
     SV *msv;
     STRLEN msglen;
+    I32 utf8 = 0;
 
     msv = vmess(pat, args);
+    utf8 = SvUTF8(msv);
     message = SvPV(msv, msglen);
 
     if (PL_warnhook) {
@@ -1264,6 +1274,7 @@ Perl_vwarn(pTHX_ const char* pat, va_list *args)
 	    ENTER;
 	    save_re_context();
 	    msg = newSVpvn(message, msglen);
+	    SvFLAGS(msg) |= utf8;
 	    SvREADONLY_on(msg);
 	    SAVEFREESV(msg);
 
@@ -1342,9 +1353,11 @@ Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
     CV *cv;
     SV *msv;
     STRLEN msglen;
+    I32 utf8 = 0;
 
     msv = vmess(pat, args);
     message = SvPV(msv, msglen);
+    utf8 = SvUTF8(msv);
 
     if (ckDEAD(err)) {
 	if (PL_diehook) {
@@ -1362,6 +1375,7 @@ Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
 		ENTER;
 		save_re_context();
 		msg = newSVpvn(message, msglen);
+		SvFLAGS(msg) |= utf8;
 		SvREADONLY_on(msg);
 		SAVEFREESV(msg);
 
@@ -1376,6 +1390,7 @@ Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
 	}
 	if (PL_in_eval) {
 	    PL_restartop = die_where(message, msglen);
+	    SvFLAGS(ERRSV) |= utf8;
 	    JMPENV_JUMP(3);
 	}
 	write_to_stderr(message, msglen);
@@ -1397,6 +1412,7 @@ Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
 		ENTER;
 		save_re_context();
 		msg = newSVpvn(message, msglen);
+		SvFLAGS(msg) |= utf8;
 		SvREADONLY_on(msg);
 		SAVEFREESV(msg);
 
@@ -1516,6 +1532,7 @@ Perl_my_setenv(pTHX_ char *nam,char *val)
 
 #endif /* WIN32 || NETWARE */
 
+#ifndef PERL_MICRO
 I32
 Perl_setenv_getix(pTHX_ char *nam)
 {
@@ -1533,6 +1550,7 @@ Perl_setenv_getix(pTHX_ char *nam)
     }					/* potential SEGV's */
     return i;
 }
+#endif /* !PERL_MICRO */
 
 #endif /* !VMS && !EPOC*/
 
@@ -4378,7 +4396,7 @@ Perl_seed(pTHX)
 }
 
 UV
-Perl_get_seed(pTHX)
+Perl_get_hash_seed(pTHX)
 {
      char *s = PerlEnv_getenv("PERL_HASH_SEED");
      UV myseed = 0;
@@ -4394,7 +4412,6 @@ Perl_get_seed(pTHX)
      {
 	  /* Compute a random seed */
 	  (void)seedDrand01((Rand_seed_t)seed());
-	  PL_srand_called = TRUE;
 	  myseed = (UV)(Drand01() * (NV)UV_MAX);
 #if RANDBITS < (UVSIZE * 8)
 	  /* Since there are not enough randbits to to reach all
@@ -4404,8 +4421,13 @@ Perl_get_seed(pTHX)
 	  myseed +=
 	       (UV)(Drand01() * (NV)((1 << ((UVSIZE * 8 - RANDBITS))) - 1));
 #endif /* RANDBITS < (UVSIZE * 8) */
+	  if (myseed == 0) { /* Superparanoia. */
+	      myseed = (UV)(Drand01() * (NV)UV_MAX); /* One more chance. */
+	      if (myseed == 0)
+		  Perl_croak(aTHX_ "Your random numbers are not that random");
+	  }
      }
-     PL_hash_seed_set = TRUE;
+     PL_rehash_seed_set = TRUE;
 
      return myseed;
 }