sv.h: Make BmUSEFUL the same type on debug/non-debug builds

[perl5.git] / numeric.c

diff --git a/numeric.c b/numeric.c
index e7e740f..e96252a 100644 (file)
--- a/numeric.c
+++ b/numeric.c
@@ -131,6 +131,10 @@ C<PERL_SCAN_ALLOW_UNDERSCORES> is set in I<*flags> then the binary
 number may use '_' characters to separate digits.
 
 =cut
+
+Not documented yet because experimental is C<PERL_SCAN_SILENT_NON_PORTABLE
+which suppresses any message for non-portable numbers that are still valid
+on this platform.
  */
 
 UV
@@ -176,6 +180,7 @@ Perl_grok_bin(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
                     continue;
                 }
                 /* Bah. We're just overflowed.  */
+               /* diag_listed_as: Integer overflow in %s number */
                Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW),
                                 "Integer overflow in binary number");
                 overflowed = TRUE;
@@ -206,7 +211,8 @@ Perl_grok_bin(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
     
     if (   ( overflowed && value_nv > 4294967295.0)
 #if UVSIZE > 4
-       || (!overflowed && value > 0xffffffff  )
+       || (!overflowed && value > 0xffffffff
+           && ! (*flags & PERL_SCAN_SILENT_NON_PORTABLE))
 #endif
        ) {
        Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE),
@@ -248,6 +254,10 @@ C<PERL_SCAN_ALLOW_UNDERSCORES> is set in I<*flags> then the hex
 number may use '_' characters to separate digits.
 
 =cut
+
+Not documented yet because experimental is C<PERL_SCAN_SILENT_NON_PORTABLE
+which suppresses any message for non-portable numbers that are still valid
+on this platform.
  */
 
 UV
@@ -293,6 +303,7 @@ Perl_grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
                     continue;
                 }
                 /* Bah. We're just overflowed.  */
+               /* diag_listed_as: Integer overflow in %s number */
                Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW),
                                 "Integer overflow in hexadecimal number");
                 overflowed = TRUE;
@@ -323,7 +334,8 @@ Perl_grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
     
     if (   ( overflowed && value_nv > 4294967295.0)
 #if UVSIZE > 4
-       || (!overflowed && value > 0xffffffff  )
+       || (!overflowed && value > 0xffffffff
+           && ! (*flags & PERL_SCAN_SILENT_NON_PORTABLE))
 #endif
        ) {
        Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE),
@@ -349,7 +361,7 @@ On entry I<start> and I<*len> give the string to scan, I<*flags> gives
 conversion flags, and I<result> should be NULL or a pointer to an NV.
 The scan stops at the end of the string, or the first invalid character.
 Unless C<PERL_SCAN_SILENT_ILLDIGIT> is set in I<*flags>, encountering an
-invalid character will also trigger a warning.
+8 or 9 will also trigger a warning.
 On return I<*len> is set to the length of the scanned string,
 and I<*flags> gives output flags.
 
@@ -363,6 +375,10 @@ If C<PERL_SCAN_ALLOW_UNDERSCORES> is set in I<*flags> then the octal
 number may use '_' characters to separate digits.
 
 =cut
+
+Not documented yet because experimental is C<PERL_SCAN_SILENT_NON_PORTABLE>
+which suppresses any message for non-portable numbers, but which are valid
+on this platform.
  */
 
 UV
@@ -393,6 +409,7 @@ Perl_grok_oct(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
                     continue;
                 }
                 /* Bah. We're just overflowed.  */
+               /* diag_listed_as: Integer overflow in %s number */
                Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW),
                               "Integer overflow in octal number");
                 overflowed = TRUE;
@@ -428,7 +445,8 @@ Perl_grok_oct(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
     
     if (   ( overflowed && value_nv > 4294967295.0)
 #if UVSIZE > 4
-       || (!overflowed && value > 0xffffffff  )
+       || (!overflowed && value > 0xffffffff
+           && ! (*flags & PERL_SCAN_SILENT_NON_PORTABLE))
 #endif
        ) {
        Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE),
@@ -515,7 +533,7 @@ Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send)
 
     PERL_ARGS_ASSERT_GROK_NUMERIC_RADIX;
 
-    if (PL_numeric_radix_sv && IN_LOCALE) { 
+    if (PL_numeric_radix_sv && IN_SOME_LOCALE_FORM) {
         STRLEN len;
         const char * const radix = SvPV(PL_numeric_radix_sv, len);
         if (*sp + len <= send && memEQ(*sp, radix, len)) {
@@ -785,7 +803,7 @@ S_mulexp10(NV value, I32 exponent)
      * a hammer.  Therefore we need to catch potential overflows before
      * it's too late. */
 
-#if ((defined(VMS) && !defined(__IEEE_FP)) || defined(_UNICOS)) && defined(NV_MAX_10_EXP)
+#if ((defined(VMS) && !defined(_IEEE_FP)) || defined(_UNICOS)) && defined(NV_MAX_10_EXP)
     STMT_START {
        const NV exp_v = log10(value);
        if (exponent >= NV_MAX_10_EXP || exponent + exp_v >= NV_MAX_10_EXP)
@@ -829,17 +847,28 @@ Perl_my_atof(pTHX_ const char* s)
 
     PERL_ARGS_ASSERT_MY_ATOF;
 
-    if (PL_numeric_local && IN_LOCALE) {
-       NV y;
+    if (PL_numeric_local && PL_numeric_radix_sv && IN_SOME_LOCALE_FORM) {
+        const char *standard = NULL, *local = NULL;
+        bool use_standard_radix;
 
-       /* Scan the number twice; once using locale and once without;
-        * choose the larger result (in absolute value). */
-       Perl_atof2(s, x);
-       SET_NUMERIC_STANDARD();
-       Perl_atof2(s, y);
-       SET_NUMERIC_LOCAL();
-       if ((y < 0.0 && y < x) || (y > 0.0 && y > x))
-           return y;
+        /* Look through the string for the first thing that looks like a
+         * decimal point: either the value in the current locale or the
+         * standard fallback of '.'. The one which appears earliest in the
+         * input string is the one that we should have atof look for. Note that
+         * we have to determine this beforehand because on some systems,
+         * Perl_atof2 is just a wrapper around the system's atof. */
+        standard = strchr(s, '.');
+        local = strstr(s, SvPV_nolen(PL_numeric_radix_sv));
+
+        use_standard_radix = standard && (!local || standard < local);
+
+        if (use_standard_radix)
+            SET_NUMERIC_STANDARD();
+
+        Perl_atof2(s, x);
+
+        if (use_standard_radix)
+            SET_NUMERIC_LOCAL();
     }
     else
        Perl_atof2(s, x);
@@ -887,7 +916,14 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value)
  * both the first and last digit, since neither can hold all values from
  * 0..9; but for calculating the value we must examine those two digits.
  */
-#define MAX_SIG_DIGITS (NV_DIG+2)
+#ifdef MAX_SIG_DIG_PLUS
+    /* It is not necessarily the case that adding 2 to NV_DIG gets all the
+       possible digits in a NV, especially if NVs are not IEEE compliant
+       (e.g., long doubles on IRIX) - Allen <allens@cpan.org> */
+# define MAX_SIG_DIGITS (NV_DIG+MAX_SIG_DIG_PLUS)
+#else
+# define MAX_SIG_DIGITS (NV_DIG+2)
+#endif
 
 /* the max number we can accumulate in a UV, and still safely do 10*N+9 */
 #define MAX_ACCUMULATE ( (UV) ((UV_MAX - 9)/10))
@@ -1080,8 +1116,8 @@ Perl_signbit(NV x) {
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
  * End:
  *
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
  */