/* numeric.c
*
- * Copyright (c) 2001, Larry Wall
+ * Copyright (c) 2001-2002, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
* wizards count differently to other people."
*/
+/*
+=head1 Numeric functions
+*/
+
#include "EXTERN.h"
#define PERL_IN_NUMERIC_C
#include "perl.h"
and writes the value to I<*result> (or the value is discarded if I<result>
is NULL).
-The hex number may optinally be prefixed with "0b" or "b". If
-C<PERL_SCAN_ALLOW_UNDERSCORES> is set in I<*flags> on entry then the binary
+The hex number may optionally be prefixed with "0b" or "b" unless
+C<PERL_SCAN_DISALLOW_PREFIX> is set in I<*flags> on entry. If
+C<PERL_SCAN_ALLOW_UNDERSCORES> is set in I<*flags> then the binary
number may use '_' characters to separate digits.
=cut
bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
bool overflowed = FALSE;
- /* strip off leading b or 0b.
- for compatibility silently suffer "b" and "0b" as valid binary numbers.
- */
- if (len >= 1) {
- if (s[0] == 'b') {
- s++;
- len--;
- }
- else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
- s+=2;
- len-=2;
- }
+ if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
+ /* strip off leading b or 0b.
+ for compatibility silently suffer "b" and "0b" as valid binary
+ numbers. */
+ if (len >= 1) {
+ if (s[0] == 'b') {
+ s++;
+ len--;
+ }
+ else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
+ s+=2;
+ len-=2;
+ }
+ }
}
for (; len-- && *s; s++) {
}
/* Bah. We're just overflowed. */
if (ckWARN_d(WARN_OVERFLOW))
- Perl_warner(aTHX_ WARN_OVERFLOW,
+ Perl_warner(aTHX_ packWARN(WARN_OVERFLOW),
"Integer overflow in binary number");
overflowed = TRUE;
value_nv = (NV) value;
}
value_nv *= 2.0;
/* If an NV has not enough bits in its mantissa to
- * represent an UV this summing of small low-order numbers
+ * represent a UV this summing of small low-order numbers
* 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 value_nv by the
goto redo;
}
if (ckWARN(WARN_DIGIT))
- Perl_warner(aTHX_ WARN_DIGIT,
+ Perl_warner(aTHX_ packWARN(WARN_DIGIT),
"Illegal binary digit '%c' ignored", *s);
break;
}
#endif
) {
if (ckWARN(WARN_PORTABLE))
- Perl_warner(aTHX_ WARN_PORTABLE,
+ Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
"Binary number > 0b11111111111111111111111111111111 non-portable");
}
*len_p = s - start;
and writes the value to I<*result> (or the value is discarded if I<result>
is NULL).
-The hex number may optinally be prefixed with "0x" or "x". If
-C<PERL_SCAN_ALLOW_UNDERSCORES> is set in I<*flags> on entry then the hex
+The hex number may optionally be prefixed with "0x" or "x" unless
+C<PERL_SCAN_DISALLOW_PREFIX> is set in I<*flags> on entry. If
+C<PERL_SCAN_ALLOW_UNDERSCORES> is set in I<*flags> then the hex
number may use '_' characters to separate digits.
=cut
bool overflowed = FALSE;
const char *hexdigit;
- /* strip off leading x or 0x.
- for compatibility silently suffer "x" and "0x" as valid hex numbers. */
- if (len >= 1) {
- if (s[0] == 'x') {
- s++;
- len--;
- }
- else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
- s+=2;
- len-=2;
- }
+ if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
+ /* strip off leading x or 0x.
+ for compatibility silently suffer "x" and "0x" as valid hex numbers.
+ */
+ if (len >= 1) {
+ if (s[0] == 'x') {
+ s++;
+ len--;
+ }
+ else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
+ s+=2;
+ len-=2;
+ }
+ }
}
for (; len-- && *s; s++) {
}
/* Bah. We're just overflowed. */
if (ckWARN_d(WARN_OVERFLOW))
- Perl_warner(aTHX_ WARN_OVERFLOW,
+ Perl_warner(aTHX_ packWARN(WARN_OVERFLOW),
"Integer overflow in hexadecimal number");
overflowed = TRUE;
value_nv = (NV) value;
}
value_nv *= 16.0;
/* If an NV has not enough bits in its mantissa to
- * represent an UV this summing of small low-order numbers
+ * represent a UV this summing of small low-order numbers
* 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 value_nv by the
goto redo;
}
if (ckWARN(WARN_DIGIT))
- Perl_warner(aTHX_ WARN_DIGIT,
+ Perl_warner(aTHX_ packWARN(WARN_DIGIT),
"Illegal hexadecimal digit '%c' ignored", *s);
break;
}
#endif
) {
if (ckWARN(WARN_PORTABLE))
- Perl_warner(aTHX_ WARN_PORTABLE,
+ Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
"Hexadecimal number > 0xffffffff non-portable");
}
*len_p = s - start;
}
/* Bah. We're just overflowed. */
if (ckWARN_d(WARN_OVERFLOW))
- Perl_warner(aTHX_ WARN_OVERFLOW,
+ Perl_warner(aTHX_ packWARN(WARN_OVERFLOW),
"Integer overflow in octal number");
overflowed = TRUE;
value_nv = (NV) value;
}
value_nv *= 8.0;
/* If an NV has not enough bits in its mantissa to
- * represent an UV this summing of small low-order numbers
+ * represent a UV this summing of small low-order numbers
* 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 value_nv by the
* someone seems to want to use the digits eight and nine). */
if (digit == 8 || digit == 9) {
if (ckWARN(WARN_DIGIT))
- Perl_warner(aTHX_ WARN_DIGIT,
+ Perl_warner(aTHX_ packWARN(WARN_DIGIT),
"Illegal octal digit '%c' ignored", *s);
}
break;
#endif
) {
if (ckWARN(WARN_PORTABLE))
- Perl_warner(aTHX_ WARN_PORTABLE,
+ Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
"Octal number > 037777777777 non-portable");
}
*len_p = s - start;