Re: [PATCH] Fix hpux10 string to real conversion defficiences

["John David Anglin" <dave at hiauly1 dot hia dot nrc dot ca>]

> I have reviewed the patch and FX'scomments.  So far so good.
> 
> I may have missed something in the thread, but are you planning
> modifications to the functions that call convert_real to allow the nan
> or inf strings to be passed to convert_real?
> 
> The read_real function is already handling this for namelist and list
> directed reads and I believe it is not needed by convert_real for those
> functions.
> 
> For formatted reads, read_f will error out on a nan or inf during the
> read before calling convert_real.

Here is take three.  The configure checks are eliminated and a new
function, convert_infnan, is added to convert INFs and NANs using
builtins.  It relies to some extent on the processing done by read_f,
parse_real and read_real.

Tested on hppa1.1-hp-hpux10.20, hppa2.0w-hp-hpux11.11, hppa64-hp-hpux11.11
and i686-apple-darwin9 with no observed regressions.

Ok?

Dave
-- 
J. David Anglin                                  dave.anglin@nrc-cnrc.gc.ca
National Research Council of Canada              (613) 990-0752 (FAX: 952-6602)

2011-03-11  John David Anglin  <dave.anglin@nrc-cnrc.gc.ca>

	PR fortran/35667
	* io/io.h (convert_infnan): Declare.
	* io/read.c (convert_infnan): New.
	(read_f): Use convert_infnan to convert INFs and NANs.
	* list_read.c (parse_real, read_real): Likewise.

Index: io/list_read.c
===================================================================
--- io/list_read.c	(revision 170842)
+++ io/list_read.c	(working copy)
@@ -1215,6 +1215,15 @@
 
   return m;
 
+ done_infnan:
+  unget_char (dtp, c);
+  push_char (dtp, '\0');
+
+  m = convert_infnan (dtp, buffer, dtp->u.p.saved_string, length);
+  free_saved (dtp);
+
+  return m;
+
  inf_nan:
   /* Match INF and Infinity.  */
   if ((c == 'i' || c == 'I')
@@ -1235,7 +1244,7 @@
 	     push_char (dtp, 'i');
 	     push_char (dtp, 'n');
 	     push_char (dtp, 'f');
-	     goto done;
+	     goto done_infnan;
 	  }
     } /* Match NaN.  */
   else if (((c = next_char (dtp)) == 'a' || c == 'A')
@@ -1259,7 +1268,7 @@
 	  if (is_separator (c))
 	    unget_char (dtp, c);
 	}
-      goto done;
+      goto done_infnan;
     }
 
  bad:
@@ -1718,8 +1727,16 @@
     }
 
   free_line (dtp);
-  goto done;
+  unget_char (dtp, c);
+  eat_separator (dtp);
+  push_char (dtp, '\0');
+  if (convert_infnan (dtp, dest, dtp->u.p.saved_string, length))
+    return;
 
+  free_saved (dtp);
+  dtp->u.p.saved_type = BT_REAL;
+  return;
+
  unwind:
   if (dtp->u.p.namelist_mode)
     {
Index: io/read.c
===================================================================
--- io/read.c	(revision 170842)
+++ io/read.c	(working copy)
@@ -189,7 +189,76 @@
   return 0;
 }
 
+/* convert_infnan()-- Convert character INF/NAN representation to the
+   machine number.  Note: many architectures (e.g. IA-64, HP-PA) require
+   that the storage pointed to by the dest argument is properly aligned
+   for the type in question.  */
 
+int
+convert_infnan (st_parameter_dt *dtp, void *dest, const char *buffer,
+	        int length)
+{
+  const char *s = buffer;
+  int is_inf, plus = 1;
+
+  if (*s == '+')
+    s++;
+  else if (*s == '-')
+    {
+      s++;
+      plus = 0;
+    }
+
+  is_inf = *s == 'i';
+
+  switch (length)
+    {
+    case 4:
+      if (is_inf)
+	*((GFC_REAL_4*) dest) = plus ? __builtin_inff () : -__builtin_inff ();
+      else
+	*((GFC_REAL_4*) dest) = plus ? __builtin_nanf ("") : -__builtin_nanf ("");
+      break;
+
+    case 8:
+      if (is_inf)
+	*((GFC_REAL_8*) dest) = plus ? __builtin_inf () : -__builtin_inf ();
+      else
+	*((GFC_REAL_8*) dest) = plus ? __builtin_nan ("") : -__builtin_nan ("");
+      break;
+
+#if defined(HAVE_GFC_REAL_10)
+    case 10:
+      if (is_inf)
+	*((GFC_REAL_10*) dest) = plus ? __builtin_infl () : -__builtin_infl ();
+      else
+	*((GFC_REAL_10*) dest) = plus ? __builtin_nanl ("") : -__builtin_nanl ("");
+      break;
+#endif
+
+#if defined(HAVE_GFC_REAL_16)
+# if defined(GFC_REAL_16_IS_FLOAT128)
+    case 16:
+      *((GFC_REAL_16*) dest) = __qmath_(strtoflt128) (buffer, NULL);
+      break;
+# else
+    case 16:
+      if (is_inf)
+	*((GFC_REAL_16*) dest) = plus ? __builtin_infl () : -__builtin_infl ();
+      else
+	*((GFC_REAL_16*) dest) = plus ? __builtin_nanl ("") : -__builtin_nanl ("");
+      break;
+# endif
+#endif
+
+    default:
+      internal_error (&dtp->common, "Unsupported real kind during IO");
+    }
+
+  return 0;
+}
+
+
 /* read_l()-- Read a logical value */
 
 void
@@ -896,7 +965,7 @@
       else if (strcmp (save, "nan") != 0)
 	goto bad_float;
 
-      convert_real (dtp, dest, buffer, length);
+      convert_infnan (dtp, dest, buffer, length);
       return;
     }
 
Index: io/io.h
===================================================================
--- io/io.h	(revision 170842)
+++ io/io.h	(working copy)
@@ -674,6 +674,9 @@
 extern int convert_real (st_parameter_dt *, void *, const char *, int);
 internal_proto(convert_real);
 
+extern int convert_infnan (st_parameter_dt *, void *, const char *, int);
+internal_proto(convert_infnan);
+
 extern void read_a (st_parameter_dt *, const fnode *, char *, int);
 internal_proto(read_a);