2010-06-29 Jerry DeLisle <jvdelisle@gcc.gnu.org>

	PR libfortran/43298
	* io/read.c: Add code to parse and read Inf, Infinity, NaN, and Nan with
	optional parenthesis.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@161585 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 33a312c..0e5eb36 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,9 @@
+2010-06-29  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR libfortran/43298
+       * io/read.c: Add code to parse and read Inf, Infinity, NaN, and Nan with
+       optional parenthesis.
+
 2010-06-28  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/43298

diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index 6aaa506..873d26c 100644 (file)
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -810,6 +810,66 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
   if (w == 0)
     goto zero;
 
+  /* Check for Infinity or NaN.  */    
+  if (unlikely ((w >= 3 && (*p == 'i' || *p == 'I' || *p == 'n' || *p == 'N'))))
+    {
+      int seen_paren = 0;
+      char *save = out;
+
+      /* Scan through the buffer keeping track of spaces and parenthesis. We
+        null terminate the string as soon as we see a left paren or if we are
+        BLANK_NULL mode.  Leading spaces have already been skipped above,
+        trailing spaces are ignored by converting to '\0'. A space
+        between "NaN" and the optional perenthesis is not permitted.  */
+      while (w > 0)
+       {
+         *out = tolower (*p);
+         switch (*p)
+           {
+           case ' ':
+             if (dtp->u.p.blank_status == BLANK_ZERO)
+               {
+                 *out = '0';
+                 break;
+               }
+             *out = '\0';
+             if (seen_paren == 1)
+               goto bad_float;
+             break;
+           case '(':
+             seen_paren++;
+             *out = '\0';
+             break;
+           case ')':
+             if (seen_paren++ != 1)
+               goto bad_float;
+             break;
+           default:
+             if (!isalnum (*out))
+               goto bad_float;
+           }
+         --w;
+         ++p;
+         ++out;
+       }
+        
+      *out = '\0';
+      
+      if (seen_paren != 0 && seen_paren != 2)
+       goto bad_float;
+
+      if ((strcmp (save, "inf") == 0) || (strcmp (save, "infinity") == 0))
+       {
+          if (seen_paren)
+            goto bad_float;
+       }
+      else if (strcmp (save, "nan") != 0)
+       goto bad_float;
+
+      convert_real (dtp, dest, buffer, length);
+      return;
+    }
+
   /* Process the mantissa string.  */
   while (w > 0)
     {