Unicode data updated to be the latest beta of the Unicode 3.0.

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

diff --git a/util.c b/util.c
index 4ef55f2..132ec5e 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1405,16 +1405,29 @@ Perl_mess(pTHX_ const char *pat, va_list *args)
     sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
     if (!SvCUR(sv) || *(SvEND(sv) - 1) != '\n') {
        dTHR;
+#ifdef IV_IS_QUAD
+       if (PL_curcop->cop_line)
+           Perl_sv_catpvf(aTHX_ sv, " at %_ line %" PERL_PRId64,
+                     GvSV(PL_curcop->cop_filegv), (IV)PL_curcop->cop_line);
+#else
        if (PL_curcop->cop_line)
            Perl_sv_catpvf(aTHX_ sv, " at %_ line %ld",
                      GvSV(PL_curcop->cop_filegv), (long)PL_curcop->cop_line);
+#endif
        if (GvIO(PL_last_in_gv) && IoLINES(GvIOp(PL_last_in_gv))) {
            bool line_mode = (RsSIMPLE(PL_rs) &&
                              SvCUR(PL_rs) == 1 && *SvPVX(PL_rs) == '\n');
+#ifdef IV_IS_QUAD
+           Perl_sv_catpvf(aTHX_ sv, ", <%s> %s %" PERL_PRId64,
+                     PL_last_in_gv == PL_argvgv ? "" : GvNAME(PL_last_in_gv),
+                     line_mode ? "line" : "chunk", 
+                     (IV)IoLINES(GvIOp(PL_last_in_gv)));
+#else
            Perl_sv_catpvf(aTHX_ sv, ", <%s> %s %ld",
                      PL_last_in_gv == PL_argvgv ? "" : GvNAME(PL_last_in_gv),
                      line_mode ? "line" : "chunk", 
                      (long)IoLINES(GvIOp(PL_last_in_gv)));
+#endif
        }
 #ifdef USE_THREADS
        if (thr->tid)
@@ -1783,7 +1796,7 @@ Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
 }
 
 #ifndef VMS  /* VMS' my_setenv() is in VMS.c */
-#if !defined(WIN32) && !defined(CYGWIN32)
+#if !defined(WIN32) && !defined(CYGWIN)
 void
 Perl_my_setenv(pTHX_ char *nam, char *val)
 {
@@ -1848,8 +1861,8 @@ Perl_my_setenv(pTHX_ char *nam, char *val)
 #endif  /* PERL_USE_SAFE_PUTENV */
 }
 
-#else /* WIN32 || CYGWIN32 */
-#if defined(CYGWIN32)
+#else /* WIN32 || CYGWIN */
+#if defined(CYGWIN)
 /*
  * Save environ of perl.exe, currently Cygwin links in separate environ's
  * for each exe/dll.  Probably should be a member of impure_ptr.
@@ -2547,7 +2560,7 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
 }
 #endif /* !DOSISH */
 
-#if  !defined(DOSISH) || defined(OS2) || defined(WIN32) || defined(CYGWIN32)
+#if  !defined(DOSISH) || defined(OS2) || defined(WIN32)
 I32
 Perl_wait4pid(pTHX_ int pid, int *statusp, int flags)
 {
@@ -2784,13 +2797,12 @@ Perl_scan_bin(pTHX_ char *start, I32 len, I32 *retlen)
     register UV ruv = 0;
     register bool seenb = FALSE;
     register bool overflowed = FALSE;
-    char *nonzero = NULL;
 
     for (; len-- && *s; s++) {
        if (!(*s == '0' || *s == '1')) {
            if (*s == '_')
                continue; /* Note: does not check for __ and the like. */
-           if (seenb == FALSE && *s == 'b' && nonzero == NULL) {
+           if (seenb == FALSE && *s == 'b' && ruv == 0) {
                /* Disallow 0bbb0b0bbb... */
                seenb = TRUE;
                continue;
@@ -2802,9 +2814,6 @@ Perl_scan_bin(pTHX_ char *start, I32 len, I32 *retlen)
                                "Illegal binary digit '%c' ignored", *s);
                break;
            }
-       } else {
-           if (nonzero == NULL && *s != '0')
-               nonzero = s;
        }
        if (!overflowed) {
            register UV xuv = ruv << 1;
@@ -2826,13 +2835,17 @@ Perl_scan_bin(pTHX_ char *start, I32 len, I32 *retlen)
             * is a waste of time (because the NV cannot preserve
             * the low-order bits anyway): we could just remember when
             * did we overflow and in the end just multiply rnv by the
-            * right amount of 16-tuples. */
+            * right amount. */
            rnv += (*s - '0');
        }
     }
     if (!overflowed)
        rnv = (NV) ruv;
-    if (sizeof(UV) > 4 && nonzero && (s - nonzero) > 32) {
+    if (   ( overflowed && rnv > 4294967295.0)
+#if UV_SIZEOF > 4
+       || (!overflowed && ruv > 0xffffffff  )
+#endif
+       ) { 
        dTHR;
        if (ckWARN(WARN_UNSAFE))
            Perl_warner(aTHX_ WARN_UNSAFE,
@@ -2849,7 +2862,6 @@ Perl_scan_oct(pTHX_ char *start, I32 len, I32 *retlen)
     register NV rnv = 0.0;
     register UV ruv = 0;
     register bool overflowed = FALSE;
-    char *nonzero = NULL;
 
     for (; len-- && *s; s++) {
        if (!(*s >= '0' && *s <= '7')) {
@@ -2868,12 +2880,8 @@ Perl_scan_oct(pTHX_ char *start, I32 len, I32 *retlen)
                break;
            }
        }
-       else {
-           if (nonzero == NULL && *s != '0')
-               nonzero = s;
-       }
        if (!overflowed) {
-           register xuv = ruv << 3;
+           register UV xuv = ruv << 3;
 
            if ((xuv >> 3) != ruv) {
                dTHR;
@@ -2898,9 +2906,11 @@ Perl_scan_oct(pTHX_ char *start, I32 len, I32 *retlen)
     }
     if (!overflowed)
        rnv = (NV) ruv;
-    if (sizeof(UV) > 4 &&
-       overflowed ? rnv > 4294967295.0 :
-       (nonzero && (s - nonzero) > 10 && (ruv >> 30) > 3)) {
+    if (   ( overflowed && rnv > 4294967295.0)
+#if UV_SIZEOF > 4
+       || (!overflowed && ruv > 0xffffffff  )
+#endif
+       ) {
        dTHR;
        if (ckWARN(WARN_UNSAFE))
            Perl_warner(aTHX_ WARN_UNSAFE,
@@ -2918,7 +2928,6 @@ Perl_scan_hex(pTHX_ char *start, I32 len, I32 *retlen)
     register UV ruv = 0;
     register bool seenx = FALSE;
     register bool overflowed = FALSE;
-    char *nonzero = NULL;
     char *hexdigit;
 
     for (; len-- && *s; s++) {
@@ -2926,7 +2935,7 @@ Perl_scan_hex(pTHX_ char *start, I32 len, I32 *retlen)
        if (!hexdigit) {
            if (*s == '_')
                continue; /* Note: does not check for __ and the like. */
-           if (seenx == FALSE && *s == 'x' && nonzero == NULL) {
+           if (seenx == FALSE && *s == 'x' && ruv == 0) {
                /* Disallow 0xxx0x0xxx... */
                seenx = TRUE;
                continue;
@@ -2939,10 +2948,6 @@ Perl_scan_hex(pTHX_ char *start, I32 len, I32 *retlen)
                break;
            }
        }
-       else {
-           if (nonzero == NULL && *s != '0')
-               nonzero = s;
-       }
        if (!overflowed) {
            register UV xuv = ruv << 4;
 
@@ -2969,8 +2974,11 @@ Perl_scan_hex(pTHX_ char *start, I32 len, I32 *retlen)
     }
     if (!overflowed)
        rnv = (NV) ruv;
-    if (sizeof(UV) > 4 &&
-       nonzero && (s - nonzero) > 8) {
+    if (   ( overflowed && rnv > 4294967295.0)
+#if UV_SIZEOF > 4
+       || (!overflowed && ruv > 0xffffffff  )
+#endif
+       ) { 
        dTHR;
        if (ckWARN(WARN_UNSAFE))
            Perl_warner(aTHX_ WARN_UNSAFE,
@@ -3400,6 +3408,7 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t)
     PL_screamnext = 0;
     PL_reg_start_tmp = 0;
     PL_reg_start_tmpl = 0;
+    PL_reg_poscache = Nullch;
 
     /* parent thread's data needs to be locked while we make copy */
     MUTEX_LOCK(&t->mutex);