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
NV value_nv = 0;
const UV max_div_2 = UV_MAX / 2;
- const bool allow_underscores = (bool)(*flags & PERL_SCAN_ALLOW_UNDERSCORES);
+ const bool allow_underscores = cBOOL(*flags & PERL_SCAN_ALLOW_UNDERSCORES);
bool overflowed = FALSE;
char bit;
for compatibility silently suffer "b" and "0b" as valid binary
numbers. */
if (len >= 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;
}
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;
}
++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) {
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
UV value = 0;
NV value_nv = 0;
const UV max_div_16 = UV_MAX / 16;
- 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_HEX;
for compatibility silently suffer "x" and "0x" as valid hex numbers.
*/
if (len >= 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;
}
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;
}
++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) {
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.
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
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;
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;
}
* 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) {
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)) {
* 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)
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);
* 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))
* 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:
*/
https://perl5.git.perl.org / perl5.git / blobdiff