Patchwork [libfortran] PR43298 Fortran library does not read in NaN -Inf or Inf

login
register
mail settings
Submitter Jerry DeLisle
Date June 29, 2010, 3:44 a.m.
Message ID <4C296C1E.4000702@verizon.net>
Download mbox | patch
Permalink /patch/57240/
State New
Headers show

Comments

Jerry DeLisle - June 29, 2010, 3:44 a.m.
On 06/27/2010 01:41 PM, Tobias Burnus wrote:
> Jerry DeLisle wrote:
>> This attached patch adds code to read these special cases. The code is
>> self explanatory. This added feature is for formatted READ.
>
The attached revised patch includes the updated test case.  With this patch, 
signs are handled for inf and infinity, spaces are not allowed within 
parenthesis, and malformed parenthesis are checked.

If OK, I can commit before freeze Tuesday evening (PST).

Regression tested.

Regards,

Jerry

2010-06-28  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.

Patch

Index: libgfortran/io/read.c
===================================================================
--- libgfortran/io/read.c	(revision 161521)
+++ libgfortran/io/read.c	(working copy)
@@ -810,6 +810,66 @@  read_f (st_parameter_dt *dtp, const fnode *f, char
   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)
     {