64-bit work. Now 32-bit platforms get a 100% make test

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

diff --git a/util.c b/util.c
index 4ef55f2..45d6a6f 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1406,15 +1406,27 @@ Perl_mess(pTHX_ const char *pat, va_list *args)
     if (!SvCUR(sv) || *(SvEND(sv) - 1) != '\n') {
        dTHR;
        if (PL_curcop->cop_line)
+#ifdef IV_IS_QUAD
+           Perl_sv_catpvf(aTHX_ sv, " at %_ line %" PERL_PRId64,
+                     GvSV(PL_curcop->cop_filegv), (IV)PL_curcop->cop_line);
+#else
            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)
@@ -2784,13 +2796,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 +2813,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 +2834,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 +2861,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 +2879,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 +2905,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 +2927,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 +2934,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 +2947,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 +2973,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,