Sync with the latest MakeMaker snapshot.

[p5sagit/p5-mst-13.2.git] / util.c

diff --git a/util.c b/util.c
index aec4354..fffc1c3 100644 (file)
--- a/util.c
+++ b/util.c
@@ -18,10 +18,7 @@
 #include "perl.h"
 
 #ifndef PERL_MICRO
-#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
 #include <signal.h>
-#endif
-
 #ifndef SIG_ERR
 # define SIG_ERR ((Sighandler_t) -1)
 #endif
@@ -1033,6 +1030,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 +1045,7 @@ Perl_vdie(pTHX_ const char* pat, va_list *args)
        }
        else
            message = SvPV(msv,msglen);
+       utf8 = SvUTF8(msv);
     }
     else {
        message = Nullch;
@@ -1072,6 +1071,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 +1090,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 +1133,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 +1144,7 @@ Perl_vcroak(pTHX_ const char* pat, va_list *args)
        }
        else
            message = SvPV(msv,msglen);
+       utf8 = SvUTF8(msv);
     }
     else {
        message = Nullch;
@@ -1167,6 +1170,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 +1189,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 +1250,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 +1271,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 +1350,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 +1372,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 +1387,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 +1409,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);
 
@@ -4396,7 +4409,6 @@ Perl_get_hash_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
@@ -4406,8 +4418,13 @@ Perl_get_hash_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;
 }