[PATCH] Fix hpux10 string to real conversion defficiences

John David Anglin dave@hiauly1.hia.nrc.ca
Tue Apr 1 01:14:00 GMT 2008


The enclosed change fixes PR fortran/35667.  The new functions add
checks to convert nan, inf and infinity with various leading signs.

The change could be improved if a check were added to configure to
test the capability of strtod and friends to handle nan, inf and
infinity.  However, it's not clear to me how to do this except by
hard coding the result.

Tested on hpux1.1-hp-hpux10.20 with no regressions.

Ok for trunk and possibly active branches?

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

2008-03-31  John David Anglin  <dave.anglin@nrc-cnrc.gc.ca>

	PR fortran/35667
	* io/read.c (gfc_strtof, gfc_strtod, gfc_strtold): New functions.
	(convert_real): Use new functions.
	* configure.ac: Check for strcasecmp.
	* configure: Rebuilt.
	* config.h.in: Rebuilt.

Index: io/read.c
===================================================================
--- io/read.c	(revision 133160)
+++ io/read.c	(working copy)
@@ -126,9 +126,68 @@
 
 /* convert_real()-- Convert a character representation of a floating
  * point number to the machine number.  Returns nonzero if there is a
- * range problem during conversion.  TODO: handle not-a-numbers and
- * infinities.  */
+ * range problem during conversion.  */
 
+static float 
+gfc_strtof (const char *s, char **p)
+{
+#if defined(HAVE_STRCASECMP)
+  if (!strcasecmp (s, "nan") || !strcasecmp (s, "+nan"))
+    return __builtin_nanf ("");
+  else if (!strcasecmp (s, "-nan"))
+    return -__builtin_nanf ("");
+  else if (!strcasecmp (s, "inf") || !strcasecmp (s, "infinity")
+	   || !strcasecmp (s, "+inf") || !strcasecmp (s, "+infinity"))
+    return __builtin_inff ();
+  else if (!strcasecmp (s, "-inf") || !strcasecmp (s, "-infinity"))
+    return -__builtin_inff ();
+#endif
+
+#if defined(HAVE_STRTOF)
+  return strtof (s, p);
+#else
+  return (float) strtod (s, p);
+#endif
+}
+
+static double
+gfc_strtod (const char *s, char **p)
+{
+#if defined(HAVE_STRCASECMP)
+  if (!strcasecmp (s, "nan") || !strcasecmp (s, "+nan"))
+    return __builtin_nan ("");
+  else if (!strcasecmp (s, "-nan"))
+    return -__builtin_nan ("");
+  else if (!strcasecmp (s, "inf") || !strcasecmp (s, "infinity")
+	   || !strcasecmp (s, "+inf") || !strcasecmp (s, "+infinity"))
+    return __builtin_inf ();
+  else if (!strcasecmp (s, "-inf") || !strcasecmp (s, "-infinity"))
+    return -__builtin_inf ();
+#endif
+
+  return strtod (s, p);
+}
+
+#if defined(HAVE_STRTOLD)
+static long double
+gfc_strtold (const char *s, char **p)
+{
+#if defined(HAVE_STRCASECMP)
+  if (!strcasecmp (s, "nan") || !strcasecmp (s, "+nan"))
+    return __builtin_nanl ("");
+  else if (!strcasecmp (s, "-nan"))
+    return -__builtin_nanl ("");
+  else if (!strcasecmp (s, "inf") || !strcasecmp (s, "infinity")
+	   || !strcasecmp (s, "+inf") || !strcasecmp (s, "+infinity"))
+    return __builtin_infl ();
+  else if (!strcasecmp (s, "-inf") || !strcasecmp (s, "-infinity"))
+    return -__builtin_infl ();
+#endif
+
+  return strtold (s, p);
+}
+#endif
+
 int
 convert_real (st_parameter_dt *dtp, void *dest, const char *buffer, int length)
 {
@@ -138,25 +197,20 @@
     {
     case 4:
       {
-	GFC_REAL_4 tmp =
-#if defined(HAVE_STRTOF)
-	  strtof (buffer, NULL);
-#else
-	  (GFC_REAL_4) strtod (buffer, NULL);
-#endif
+	GFC_REAL_4 tmp = gfc_strtof (buffer, NULL);
 	memcpy (dest, (void *) &tmp, length);
       }
       break;
     case 8:
       {
-	GFC_REAL_8 tmp = strtod (buffer, NULL);
+	GFC_REAL_8 tmp = gfc_strtod (buffer, NULL);
 	memcpy (dest, (void *) &tmp, length);
       }
       break;
 #if defined(HAVE_GFC_REAL_10) && defined (HAVE_STRTOLD)
     case 10:
       {
-	GFC_REAL_10 tmp = strtold (buffer, NULL);
+	GFC_REAL_10 tmp = gfc_strtold (buffer, NULL);
 	memcpy (dest, (void *) &tmp, length);
       }
       break;
@@ -164,7 +218,7 @@
 #if defined(HAVE_GFC_REAL_16) && defined (HAVE_STRTOLD)
     case 16:
       {
-	GFC_REAL_16 tmp = strtold (buffer, NULL);
+	GFC_REAL_16 tmp = gfc_strtold (buffer, NULL);
 	memcpy (dest, (void *) &tmp, length);
       }
       break;
Index: configure.ac
===================================================================
--- configure.ac	(revision 133160)
+++ configure.ac	(working copy)
@@ -205,6 +205,7 @@
 AC_CHECK_FUNCS(sleep time ttyname signal alarm ctime clock access fork execl)
 AC_CHECK_FUNCS(wait setmode execvp pipe dup2 close fdopen strcasestr getrlimit)
 AC_CHECK_FUNCS(gettimeofday stat fstat lstat getpwuid vsnprintf dup getcwd)
+AC_CHECK_FUNCS(strcasecmp)
 
 # Check for glibc backtrace functions
 AC_CHECK_FUNCS(backtrace backtrace_symbols)



More information about the Fortran mailing list