===================================================================
@@ -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)
{
===================================================================
@@ -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;
}
===================================================================
@@ -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);