Integrate with Sarathy.

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

diff --git a/util.c b/util.c
index 3655cef..64580f6 100644 (file)
--- a/util.c
+++ b/util.c
@@ -546,7 +546,7 @@ Perl_new_collate(pTHX_ const char *newcoll)
 }
 
 void
-perl_set_numeric_radix(void)
+Perl_set_numeric_radix(pTHX)
 {
 #ifdef USE_LOCALE_NUMERIC
 # ifdef HAS_LOCALECONV
@@ -589,7 +589,7 @@ Perl_new_numeric(pTHX_ const char *newnum)
        PL_numeric_name = savepv(newnum);
        PL_numeric_standard = (strEQ(newnum, "C") || strEQ(newnum, "POSIX"));
        PL_numeric_local = TRUE;
-       perl_set_numeric_radix();
+       set_numeric_radix();
     }
 
 #endif /* USE_LOCALE_NUMERIC */
@@ -618,7 +618,7 @@ Perl_set_numeric_local(pTHX)
        setlocale(LC_NUMERIC, PL_numeric_name);
        PL_numeric_standard = FALSE;
        PL_numeric_local = TRUE;
-       perl_set_numeric_radix();
+       set_numeric_radix();
     }
 
 #endif /* USE_LOCALE_NUMERIC */
@@ -2630,7 +2630,7 @@ Perl_repeatcpy(pTHX_ register char *to, register const char *from, I32 len, regi
 }
 
 U32
-Perl_cast_ulong(pTHX_ double f)
+Perl_cast_ulong(pTHX_ NV f)
 {
     long along;
 
@@ -2667,7 +2667,7 @@ Perl_cast_ulong(pTHX_ double f)
 #endif
 
 I32
-Perl_cast_i32(pTHX_ double f)
+Perl_cast_i32(pTHX_ NV f)
 {
     if (f >= I32_MAX)
        return (I32) I32_MAX;
@@ -2677,12 +2677,12 @@ Perl_cast_i32(pTHX_ double f)
 }
 
 IV
-Perl_cast_iv(pTHX_ double f)
+Perl_cast_iv(pTHX_ NV f)
 {
     if (f >= IV_MAX) {
        UV uv;
        
-       if (f >= (double)UV_MAX)
+       if (f >= (NV)UV_MAX)
            return (IV) UV_MAX; 
        uv = (UV) f;
        return (IV)uv;
@@ -2693,7 +2693,7 @@ Perl_cast_iv(pTHX_ double f)
 }
 
 UV
-Perl_cast_uv(pTHX_ double f)
+Perl_cast_uv(pTHX_ NV f)
 {
     if (f >= MY_UV_MAX)
        return (UV) MY_UV_MAX;
@@ -2752,13 +2752,15 @@ Perl_scan_bin(pTHX_ char *start, I32 len, I32 *retlen)
     register UV retval = 0;
     bool overflowed = FALSE;
     while (len && *s >= '0' && *s <= '1') {
-      register UV n = retval << 1;
-      if (!overflowed && (n >> 1) != retval) {
-          Perl_warn(aTHX_ "Integer overflow in binary number");
-          overflowed = TRUE;
-      }
-      retval = n | (*s++ - '0');
-      len--;
+       register UV n = retval << 1;
+       if (!overflowed && (n >> 1) != retval) {
+           dTHR;
+           if (ckWARN_d(WARN_UNSAFE))
+               Perl_warner(aTHX_ WARN_UNSAFE, "Integer overflow in binary number");
+           overflowed = TRUE;
+       }
+       retval = n | (*s++ - '0');
+       len--;
     }
     if (len && (*s >= '2' && *s <= '9')) {
       dTHR;
@@ -2778,7 +2780,9 @@ Perl_scan_oct(pTHX_ char *start, I32 len, I32 *retlen)
     while (len && *s >= '0' && *s <= '7') {
        register UV n = retval << 3;
        if (!overflowed && (n >> 3) != retval) {
-           Perl_warn(aTHX_ "Integer overflow in octal number");
+           dTHR;
+           if (ckWARN_d(WARN_UNSAFE))
+               Perl_warner(aTHX_ WARN_UNSAFE, "Integer overflow in octal number");
            overflowed = TRUE;
        }
        retval = n | (*s++ - '0');
@@ -2817,7 +2821,9 @@ Perl_scan_hex(pTHX_ char *start, I32 len, I32 *retlen)
        }
        n = retval << 4;
        if (!overflowed && (n >> 4) != retval) {
-           Perl_warn(aTHX_ "Integer overflow in hex number");
+           dTHR;
+           if (ckWARN_d(WARN_UNSAFE))
+               Perl_warner(aTHX_ WARN_UNSAFE, "Integer overflow in hex number");
            overflowed = TRUE;
        }
        retval = n | ((tmp - PL_hexdigit) & 15);
@@ -3235,6 +3241,9 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t)
     PL_maxscream = -1;
     PL_regcompp = FUNC_NAME_TO_PTR(Perl_pregcomp);
     PL_regexecp = FUNC_NAME_TO_PTR(Perl_regexec_flags);
+    PL_regint_start = FUNC_NAME_TO_PTR(Perl_re_intuit_start);
+    PL_regint_string = FUNC_NAME_TO_PTR(Perl_re_intuit_string);
+    PL_regfree = FUNC_NAME_TO_PTR(Perl_pregfree);
     PL_regindent = 0;
     PL_reginterp_cnt = 0;
     PL_lastscream = Nullsv;
@@ -3303,7 +3312,7 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t)
  * So it is in perl for (say) POSIX to use. 
  * Needed for SunOS with Sun's 'acc' for example.
  */
-double 
+NV 
 Perl_huge(void)
 {
  return HUGE_VAL;
@@ -3506,22 +3515,23 @@ Perl_my_fflush_all(pTHX)
 #endif
 }
 
-double
+NV
 Perl_my_atof(pTHX_ const char* s) {
 #ifdef USE_LOCALE_NUMERIC
     if ((PL_hints & HINT_LOCALE) && PL_numeric_local) {
-       double x, y;
+       NV x, y;
 
-       x = atof(s);
+       x = Perl_atof(s);
        SET_NUMERIC_STANDARD();
-       y = atof(s);
+       y = Perl_atof(s);
        SET_NUMERIC_LOCAL();
        if ((y < 0.0 && y < x) || (y > 0.0 && y > x))
            return y;
        return x;
-    } else
-       return atof(s);
+    }
+    else
+       return Perl_atof(s);
 #else
-    return atof(s);
+    return Perl_atof(s);
 #endif
 }