re PR libfortran/35667 (HP-UX 10 has broken strtod)

	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.

From-SVN: r171182

1 files changed, 70 insertions, 1 deletions

diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index 50b1b408e9b..d8d2a81a6d3 100644
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -189,6 +189,75 @@ convert_real (st_parameter_dt *dtp, void *dest, const char *buffer, int length)
   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 */
 
@@ -896,7 +965,7 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
       else if (strcmp (save, "nan") != 0)
 	goto bad_float;
 
-      convert_real (dtp, dest, buffer, length);
+      convert_infnan (dtp, dest, buffer, length);
       return;
     }