This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
infnan: allow (silently) trailing whitespace.
authorJarkko Hietaniemi <jhi@iki.fi>
Mon, 26 Jan 2015 02:01:07 +0000 (21:01 -0500)
committerJarkko Hietaniemi <jhi@iki.fi>
Wed, 28 Jan 2015 11:52:32 +0000 (06:52 -0500)
(Leading whitespace is handled in grok_number_flags.)

numeric.c
t/op/infnan.t

index 7819c60..fe61332 100644 (file)
--- a/numeric.c
+++ b/numeric.c
@@ -598,6 +598,8 @@ or "not a number", and returns one of the following flag combinations:
   IS_NUMBER_NAN | IS_NUMBER_NEG
   0
 
+possibly with IS_NUMBER_TRAILING.
+
 If an infinity or not-a-number is recognized, the *sp will point to
 one past the end of the recognized string.  If the recognition fails,
 zero is returned, and the *sp will not move.
@@ -644,7 +646,9 @@ Perl_grok_infnan(const char** sp, const char* send)
             while (*s == '0') { /* 1.#INF00 */
                 s++;
             }
-            if (*s) {
+            while (s < send && isSPACE(*s))
+                s++;
+            if (s < send && *s) {
                 flags |= IS_NUMBER_TRAILING;
             }
             flags |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
@@ -760,16 +764,20 @@ Perl_grok_infnan(const char** sp, const char* send)
                     /* Looked like nan(...), but no close paren. */
                     flags |= IS_NUMBER_TRAILING;
                 }
-            } else if (*s) {
-                /* Note that we here implicitly accept (parse as
-                 * "nan", but with warnings) also any other weird
-                 * trailing stuff for "nan".  In the above we just
-                 * check that if we got the C99-style "nan(...)",
-                 * the "..."  looks sane.
-                 * If in future we accept more ways of specifying
-                 * the nan payload, the accepting would happen around
-                 * here. */
-                flags |= IS_NUMBER_TRAILING;
+            } else {
+                while (s < send && isSPACE(*s))
+                    s++;
+                if (s < send && *s) {
+                    /* Note that we here implicitly accept (parse as
+                     * "nan", but with warnings) also any other weird
+                     * trailing stuff for "nan".  In the above we just
+                     * check that if we got the C99-style "nan(...)",
+                     * the "..."  looks sane.
+                     * If in future we accept more ways of specifying
+                     * the nan payload, the accepting would happen around
+                     * here. */
+                    flags |= IS_NUMBER_TRAILING;
+                }
             }
             s = send;
         }
@@ -777,6 +785,9 @@ Perl_grok_infnan(const char** sp, const char* send)
             return 0;
     }
 
+    while (s < send && isSPACE(*s))
+        s++;
+
     *sp = s;
     return flags;
 }
index ae84111..bddea57 100644 (file)
@@ -461,6 +461,9 @@ cmp_ok('-1e-9999', '==', 0,     "underflow to 0 (runtime) from neg");
          [ "1.#INFx",      1, $PInf ],
          [ "1.#INF00",     0, $PInf ],
          [ "1.#INFxy",     1, $PInf ],
+         [ " inf",         0, $PInf ],
+         [ "inf ",         0, $PInf ],
+         [ " inf ",        0, $PInf ],
 
          [ "nan",          0, $NaN ],
          [ "nanxy",        1, $NaN ],
@@ -483,10 +486,13 @@ cmp_ok('-1e-9999', '==', 0,     "underflow to 0 (runtime) from neg");
          [ "1.#IND",       0, $NaN ],
          [ "1.#IND00",     0, $NaN ],
          [ "1.#INDxy",     1, $NaN ],
+         [ " nan",         0, $NaN ],
+         [ "nan ",         0, $NaN ],
+         [ " nan ",        0, $NaN ],
         ];
 
     for my $t (@$T) {
-        print "# $t->[0] compile time\n";
+        print "# '$t->[0]' compile time\n";
         my $a;
         $w = '';
         eval '$a = "'.$t->[0].'" + 1';
@@ -497,7 +503,7 @@ cmp_ok('-1e-9999', '==', 0,     "underflow to 0 (runtime) from neg");
         } else {
             is($w, "", "no warning expected");
         }
-        print "# $t->[0] runtime\n";
+        print "# '$t->[0]' runtime\n";
         my $n = $t->[0];
         my $b;
         $w = '';