Beginnings of better Inf and NaN support.

At least toke.c and sv.c still need quite a bit of work.

p4raw-id: //depot/perl@11489

2 files changed, 63 insertions, 3 deletions

diff --git a/numeric.c b/numeric.c
index 43636698ef..e7a5e8d7e6 100644
--- a/numeric.c
+++ b/numeric.c
@@ -350,7 +350,7 @@ Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send)
 Recognise (or not) a number.  The type of the number is returned
 (0 if unrecognised), otherwise it is a bit-ORed combination of
 IS_NUMBER_IN_UV, IS_NUMBER_GREATER_THAN_UV_MAX, IS_NUMBER_NOT_INT,
-IS_NUMBER_NEG, IS_NUMBER_INFINITY (defined in perl.h).
+IS_NUMBER_NEG, IS_NUMBER_INFINITY, IS_NUMBER_NAN (defined in perl.h).
 
 If the value of the number can fit an in UV, it is returned in the *valuep
 IS_NUMBER_IN_UV will be set to indicate that *valuep is valid, IS_NUMBER_IN_UV
@@ -376,6 +376,7 @@ Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep)
   const char max_mod_10 = UV_MAX % 10;
   int numtype = 0;
   int sawinf = 0;
+  int sawnan = 0;
 
   while (s < send && isSPACE(*s))
     s++;
@@ -512,12 +513,21 @@ Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep)
       s++;
     }
     sawinf = 1;
-  } else /* Add test for NaN here.  */
+  } else if (*s == 'N' || *s == 'n') {
+    /* XXX TODO: There are signaling NaNs and quiet NaNs. */
+    s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
+    s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
+    s++;
+    sawnan = 1;
+  } else
     return 0;
 
   if (sawinf) {
     numtype &= IS_NUMBER_NEG; /* Keep track of sign  */
     numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
+  } else if (sawnan) {
+    numtype &= IS_NUMBER_NEG; /* Keep track of sign  */
+    numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
   } else if (s < send) {
     /* we can have an optional exponent part */
     if (*s == 'e' || *s == 'E') {
@@ -539,7 +549,7 @@ Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep)
   while (s < send && isSPACE(*s))
     s++;
   if (s >= send)
-  return numtype;
+    return numtype;
   if (len == 10 && memEQ(pv, "0 but true", 10)) {
     if (valuep)
       *valuep = 0;
diff --git a/perl.h b/perl.h
index 9041aa010d..8e975f1ba0 100644
--- a/perl.h
+++ b/perl.h
@@ -2493,6 +2493,55 @@ START_EXTERN_C
 END_EXTERN_C
 #endif
 
+#if !defined(NV_INF) && defined(USE_LONG_DOUBLE) && defined(LDBL_INFINITY)
+#  define NV_INF LDBL_INFINITY
+#endif
+#if !defined(NV_INF) && defined(DBL_INFINITY)
+#  define NV_INF (NV)DBL_INFINITY
+#endif
+#if !defined(NV_INF) && defined(INFINITY)
+#  define NV_INF (NV)INFINITY
+#endif
+#if !defined(NV_INF) && defined(INF)
+#  define NV_INF (NV)INF
+#endif
+#if !defined(NV_INF) && defined(USE_LONG_DOUBLE) && defined(HUGE_VALL)
+#  define NV_INF (NV)HUGE_VALL
+#endif
+#if !defined(NV_INF) && defined(HUGE_VAL)
+#  define NV_INF (NV)HUGE_VAL
+#endif
+
+#if !defined(NV_NAN) && defined(USE_LONG_DOUBLE)
+#   if !defined(NV_NAN) && defined(LDBL_NAN)
+#       define NV_NAN LDBL_NAN
+#   endif
+#   if !defined(NV_NAN) && defined(LDBL_QNAN)
+#       define NV_NAN LDBL_QNAN
+#   endif
+#   if !defined(NV_NAN) && defined(LDBL_SNAN)
+#       define NV_NAN LDBL_SNAN
+#   endif
+#endif
+#if !defined(NV_NAN) && defined(DBL_NAN)
+#  define NV_NAN (NV)DBL_NAN
+#endif
+#if !defined(NV_NAN) && defined(DBL_QNAN)
+#  define NV_NAN (NV)DBL_QNAN
+#endif
+#if !defined(NV_NAN) && defined(DBL_SNAN)
+#  define NV_NAN (NV)DBL_SNAN
+#endif
+#if !defined(NV_NAN) && defined(QNAN)
+#  define NV_NAN (NV)QNAN
+#endif
+#if !defined(NV_NAN) && defined(SNAN)
+#  define NV_NAN (NV)SNAN
+#endif
+#if !defined(NV_NAN) && defined(NAN)
+#  define NV_NAN (NV)NAN
+#endif
+
 #ifndef __cplusplus
 #  if defined(NeXT) || defined(__NeXT__) /* or whatever catches all NeXTs */
 char *crypt ();       /* Maybe more hosts will need the unprototyped version */
@@ -3773,6 +3822,7 @@ int flock(int fd, int op);
 #define IS_NUMBER_NOT_INT	      0x04 /* saw . or E notation */
 #define IS_NUMBER_NEG		      0x08 /* leading minus sign */
 #define IS_NUMBER_INFINITY	      0x10 /* this is big */
+#define IS_NUMBER_NAN                 0x20 /* this is not */
 
 #define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)