This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Refactor ReTest.pl to use test.pl for testing functions and TAP generation.
[perl5.git] / numeric.c
diff --git a/numeric.c b/numeric.c
index 761239a..505b1ce 100644 (file)
--- a/numeric.c
+++ b/numeric.c
@@ -1,7 +1,7 @@
 /*    numeric.c
  *
  *    Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
- *    2002, 2003, 2004, 2005, 2006, 2007, by Larry Wall and others
+ *    2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -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"]
  */
 
 /*
@@ -140,7 +142,7 @@ Perl_grok_bin(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
     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;
 
@@ -151,11 +153,11 @@ Perl_grok_bin(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
            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;
             }
@@ -174,9 +176,8 @@ 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");
+               Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW),
+                                "Integer overflow in binary number");
                 overflowed = TRUE;
                 value_nv = (NV) value;
             }
@@ -197,9 +198,9 @@ 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;
     }
     
@@ -208,9 +209,8 @@ Perl_grok_bin(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
        || (!overflowed && value > 0xffffffff  )
 #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) {
@@ -259,7 +259,7 @@ Perl_grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
     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;
@@ -269,11 +269,11 @@ Perl_grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
            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;
             }
@@ -293,9 +293,8 @@ 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");
+               Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW),
+                                "Integer overflow in hexadecimal number");
                 overflowed = TRUE;
                 value_nv = (NV) value;
             }
@@ -316,8 +315,8 @@ 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;
     }
@@ -327,9 +326,8 @@ Perl_grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
        || (!overflowed && value > 0xffffffff  )
 #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 +349,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.
 
@@ -375,7 +373,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 +393,8 @@ 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");
+               Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW),
+                              "Integer overflow in octal number");
                 overflowed = TRUE;
                 value_nv = (NV) value;
             }
@@ -422,9 +419,9 @@ 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;
     }
@@ -434,9 +431,8 @@ Perl_grok_oct(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
        || (!overflowed && value > 0xffffffff  )
 #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) {
@@ -891,7 +887,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))
Unnamed repository; edit this file 'description' to name the repository.