X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/1129b882ced9d5881a47214405219a2e6e332a92..50c7be83932fffb593f45edf5e5fde386fc0de6b:/numeric.c diff --git a/numeric.c b/numeric.c index 8d6bc97..e96252a 100644 --- a/numeric.c +++ b/numeric.c @@ -9,8 +9,10 @@ */ /* - * "That only makes eleven (plus one mislaid) and not fourteen, unless - * wizards count differently to other people." + * "That only makes eleven (plus one mislaid) and not fourteen, + * unless wizards count differently to other people." --Beorn + * + * [p.115 of _The Hobbit_: "Queer Lodgings"] */ /* @@ -129,6 +131,10 @@ C is set in I<*flags> then the binary number may use '_' characters to separate digits. =cut + +Not documented yet because experimental is C= 1) { - if (s[0] == 'b') { + if (s[0] == 'b' || s[0] == 'B') { s++; len--; } - else if (len >= 2 && s[0] == '0' && s[1] == 'b') { + else if (len >= 2 && s[0] == '0' && (s[1] == 'b' || s[1] == 'B')) { s+=2; len-=2; } @@ -174,9 +180,9 @@ Perl_grok_bin(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) continue; } /* Bah. We're just overflowed. */ - if (ckWARN_d(WARN_OVERFLOW)) - Perl_warner(aTHX_ packWARN(WARN_OVERFLOW), - "Integer overflow in binary number"); + /* diag_listed_as: Integer overflow in %s number */ + Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW), + "Integer overflow in binary number"); overflowed = TRUE; value_nv = (NV) value; } @@ -197,20 +203,20 @@ Perl_grok_bin(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) ++s; goto redo; } - if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT) && ckWARN(WARN_DIGIT)) - Perl_warner(aTHX_ packWARN(WARN_DIGIT), - "Illegal binary digit '%c' ignored", *s); + if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) + Perl_ck_warner(aTHX_ packWARN(WARN_DIGIT), + "Illegal binary digit '%c' ignored", *s); break; } if ( ( overflowed && value_nv > 4294967295.0) #if UVSIZE > 4 - || (!overflowed && value > 0xffffffff ) + || (!overflowed && value > 0xffffffff + && ! (*flags & PERL_SCAN_SILENT_NON_PORTABLE)) #endif ) { - if (ckWARN(WARN_PORTABLE)) - Perl_warner(aTHX_ packWARN(WARN_PORTABLE), - "Binary number > 0b11111111111111111111111111111111 non-portable"); + Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), + "Binary number > 0b11111111111111111111111111111111 non-portable"); } *len_p = s - start; if (!overflowed) { @@ -248,6 +254,10 @@ C is set in I<*flags> then the hex number may use '_' characters to separate digits. =cut + +Not documented yet because experimental is C= 1) { - if (s[0] == 'x') { + if (s[0] == 'x' || s[0] == 'X') { s++; len--; } - else if (len >= 2 && s[0] == '0' && s[1] == 'x') { + else if (len >= 2 && s[0] == '0' && (s[1] == 'x' || s[1] == 'X')) { s+=2; len-=2; } @@ -293,9 +303,9 @@ Perl_grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) continue; } /* Bah. We're just overflowed. */ - if (ckWARN_d(WARN_OVERFLOW)) - Perl_warner(aTHX_ packWARN(WARN_OVERFLOW), - "Integer overflow in hexadecimal number"); + /* diag_listed_as: Integer overflow in %s number */ + Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW), + "Integer overflow in hexadecimal number"); overflowed = TRUE; value_nv = (NV) value; } @@ -316,20 +326,20 @@ Perl_grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) ++s; goto redo; } - if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT) && ckWARN(WARN_DIGIT)) - Perl_warner(aTHX_ packWARN(WARN_DIGIT), + if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) + Perl_ck_warner(aTHX_ packWARN(WARN_DIGIT), "Illegal hexadecimal digit '%c' ignored", *s); break; } if ( ( overflowed && value_nv > 4294967295.0) #if UVSIZE > 4 - || (!overflowed && value > 0xffffffff ) + || (!overflowed && value > 0xffffffff + && ! (*flags & PERL_SCAN_SILENT_NON_PORTABLE)) #endif ) { - if (ckWARN(WARN_PORTABLE)) - Perl_warner(aTHX_ packWARN(WARN_PORTABLE), - "Hexadecimal number > 0xffffffff non-portable"); + Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), + "Hexadecimal number > 0xffffffff non-portable"); } *len_p = s - start; if (!overflowed) { @@ -351,7 +361,7 @@ On entry I and I<*len> give the string to scan, I<*flags> gives conversion flags, and I 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 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. @@ -365,6 +375,10 @@ If C is set in I<*flags> then the octal number may use '_' characters to separate digits. =cut + +Not documented yet because experimental is C +which suppresses any message for non-portable numbers, but which are valid +on this platform. */ UV @@ -375,7 +389,7 @@ Perl_grok_oct(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) UV value = 0; NV value_nv = 0; const UV max_div_8 = UV_MAX / 8; - const bool allow_underscores = (bool)(*flags & PERL_SCAN_ALLOW_UNDERSCORES); + const bool allow_underscores = cBOOL(*flags & PERL_SCAN_ALLOW_UNDERSCORES); bool overflowed = FALSE; PERL_ARGS_ASSERT_GROK_OCT; @@ -395,9 +409,9 @@ Perl_grok_oct(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) continue; } /* Bah. We're just overflowed. */ - if (ckWARN_d(WARN_OVERFLOW)) - Perl_warner(aTHX_ packWARN(WARN_OVERFLOW), - "Integer overflow in octal number"); + /* diag_listed_as: Integer overflow in %s number */ + Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW), + "Integer overflow in octal number"); overflowed = TRUE; value_nv = (NV) value; } @@ -422,21 +436,21 @@ Perl_grok_oct(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) * as soon as non-octal characters are seen, complain only if * someone seems to want to use the digits eight and nine). */ if (digit == 8 || digit == 9) { - if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT) && ckWARN(WARN_DIGIT)) - Perl_warner(aTHX_ packWARN(WARN_DIGIT), - "Illegal octal digit '%c' ignored", *s); + if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) + Perl_ck_warner(aTHX_ packWARN(WARN_DIGIT), + "Illegal octal digit '%c' ignored", *s); } break; } if ( ( overflowed && value_nv > 4294967295.0) #if UVSIZE > 4 - || (!overflowed && value > 0xffffffff ) + || (!overflowed && value > 0xffffffff + && ! (*flags & PERL_SCAN_SILENT_NON_PORTABLE)) #endif ) { - if (ckWARN(WARN_PORTABLE)) - Perl_warner(aTHX_ packWARN(WARN_PORTABLE), - "Octal number > 037777777777 non-portable"); + Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), + "Octal number > 037777777777 non-portable"); } *len_p = s - start; if (!overflowed) { @@ -519,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)) { @@ -789,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) @@ -833,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); @@ -891,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 */ +# 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)) @@ -1084,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: */