X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=numeric.c;h=93f4cb4c0d862d2e93673c37990917b395d5dc9e;hb=86dc4f0369f60d4d1fe21ab8a3a480faa427ac6c;hp=c71d5b356117efe204e994012137333f4f1b90cd;hpb=53305cf15fa20bba9e66475dfc049c6ed9d96c55;p=p5sagit%2Fp5-mst-13.2.git diff --git a/numeric.c b/numeric.c index c71d5b3..93f4cb4 100644 --- a/numeric.c +++ b/numeric.c @@ -1,6 +1,6 @@ /* 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. @@ -12,6 +12,10 @@ * wizards count differently to other people." */ +/* +=head1 Numeric functions +*/ + #include "EXTERN.h" #define PERL_IN_NUMERIC_C #include "perl.h" @@ -122,8 +126,9 @@ returns UV_MAX, sets C in the output flags, and writes the value to I<*result> (or the value is discarded if I is NULL). -The hex number may optinally be prefixed with "0b" or "b". If -C is set in I<*flags> on entry then the binary +The hex number may optionally be prefixed with "0b" or "b" unless +C is set in I<*flags> on entry. If +C is set in I<*flags> then the binary number may use '_' characters to separate digits. =cut @@ -140,18 +145,20 @@ Perl_grok_bin(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { 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++) { @@ -168,14 +175,14 @@ Perl_grok_bin(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { } /* 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 @@ -191,7 +198,7 @@ Perl_grok_bin(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { goto redo; } if (ckWARN(WARN_DIGIT)) - Perl_warner(aTHX_ WARN_DIGIT, + Perl_warner(aTHX_ packWARN(WARN_DIGIT), "Illegal binary digit '%c' ignored", *s); break; } @@ -202,7 +209,7 @@ Perl_grok_bin(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { #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; @@ -233,8 +240,9 @@ returns UV_MAX, sets C in the output flags, and writes the value to I<*result> (or the value is discarded if I is NULL). -The hex number may optinally be prefixed with "0x" or "x". If -C is set in I<*flags> on entry then the hex +The hex number may optionally be prefixed with "0x" or "x" unless +C is set in I<*flags> on entry. If +C is set in I<*flags> then the hex number may use '_' characters to separate digits. =cut @@ -252,17 +260,20 @@ Perl_grok_hex(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { 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++) { @@ -279,14 +290,14 @@ Perl_grok_hex(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { } /* 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 @@ -302,7 +313,7 @@ Perl_grok_hex(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { goto redo; } if (ckWARN(WARN_DIGIT)) - Perl_warner(aTHX_ WARN_DIGIT, + Perl_warner(aTHX_ packWARN(WARN_DIGIT), "Illegal hexadecimal digit '%c' ignored", *s); break; } @@ -313,7 +324,7 @@ Perl_grok_hex(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { #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; @@ -361,14 +372,14 @@ Perl_grok_oct(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { } /* 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 @@ -388,7 +399,7 @@ Perl_grok_oct(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { * 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; @@ -400,7 +411,7 @@ Perl_grok_oct(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) { #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;