[PATCH] Fix hpux10 string to real conversion defficiences
John David Anglin
dave@hiauly1.hia.nrc.ca
Fri Apr 11 05:42:00 GMT 2008
> >> 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.
> > It think one can test it in configure along these lines
> > a =3D strtod ("nan", NULL); if(a =3D=3D a) abort();
> > a =3D strtod("+inf", NULL); if(a !=3D a || a !=3D a + 1.0 || a < 0.0) =
> =20
> > abort();
> > a =3D strtod("-inf", NULL); if(a !=3D a || a !=3D a - 1.0 || a > 0.0) =
> =20
> > abort();
>
> I also am in favour of a configure test. You can look into =20
> libgfortran/acinclude.m4 to see how LIBGFOR_CHECK_FOR_BROKEN_ISNAN =20
> works, for example.
Here's take two. Configure checks have been added for broken strtof,
strtod and strtold. If a function doesn't exist, the assumption is it
is not broken.
I also added two functions, nan_p and inf_p, to check for the strings
"nan", "inf" and "infinity".
The change has been tested on hppa1.1-hp-hpux10.20 with gcc 4.3.0 and
hppa-unknown-linux-gnu with gcc 4.4.0. The latter's conversion functions
are not broken, although strtod and strtold are equivalent. No regressions
were observed in either case.
Ok for trunk?
Dave
--
J. David Anglin dave.anglin@nrc-cnrc.gc.ca
National Research Council of Canada (613) 990-0752 (FAX: 952-6602)
2008-04-10 John David Anglin <dave.anglin@nrc-cnrc.gc.ca>
PR fortran/35667
* acinclude.m4 (LIBGFOR_CHECK_FOR_BROKEN_STRTOF,
LIBGFOR_CHECK_FOR_BROKEN_STRTOD, LIBGFOR_CHECK_FOR_BROKEN_STRTOLD): New
check macros.
* configure.ac: Use new check macros.
* configure: Rebuilt.
* config.h.in: Rebuilt.
* io/read.c (nan_p, inf_p, gfc_strtof, gfc_strtod, gfc_strtold): New
functions.
(convert_real): Use new functions.
Index: configure.ac
===================================================================
--- configure.ac (revision 133994)
+++ configure.ac (working copy)
@@ -389,6 +389,15 @@
# On AIX, clog is present in libm as __clog
AC_CHECK_LIB([m],[__clog],[AC_DEFINE([HAVE_CLOG],[1],[libm includes clog])])
+# Check for strtof function that can convert "nan" and "inf" strings.
+LIBGFOR_CHECK_FOR_BROKEN_STRTOF
+
+# Check for strtod function that can convert "nan" and "inf" strings.
+LIBGFOR_CHECK_FOR_BROKEN_STRTOD
+
+# Check for strtold function that can convert "nan" and "inf" strings.
+LIBGFOR_CHECK_FOR_BROKEN_STRTOLD
+
# Check for a isfinite macro that works on long doubles.
LIBGFOR_CHECK_FOR_BROKEN_ISFINITE
Index: acinclude.m4
===================================================================
--- acinclude.m4 (revision 133994)
+++ acinclude.m4 (working copy)
@@ -196,6 +196,90 @@
AC_DEFINE(HAVE_CRLF, 1, [Define if CRLF is line terminator.])
fi])
+dnl Check whether strtof is broken.
+dnl The most common problem is that it does not convert "nan", "inf"
+dnl and "infinity".
+AC_DEFUN([LIBGFOR_CHECK_FOR_BROKEN_STRTOF], [
+ AC_CACHE_CHECK([whether strtof is broken],
+ have_broken_strtof, [
+ libgfor_check_for_broken_strtof_save_LIBS=$LIBS
+ LIBS="$LIBS -lm"
+ AC_TRY_RUN([
+#include <stdlib.h>
+int main ()
+{
+#if HAVE_STRTOF
+ float a;
+ a = strtof ("nan", NULL); if(a == a) return 1;
+ a = strtof("+inf", NULL); if(a != a || a != a + 1.0 || a < 0.0) return 1;
+ a = strtof("-inf", NULL); if(a != a || a != a - 1.0 || a > 0.0) return 1;
+#endif
+return 0;
+}], have_broken_strtof=no, have_broken_strtof=yes, [
+case "${target}" in
+ *) have_broken_strtof=no ;;
+esac])]
+ LIBS=$libgfor_check_for_broken_strtof_save_LIBS)
+if test x"$have_broken_strtof" = xyes; then
+ AC_DEFINE(HAVE_BROKEN_STRTOF, 1, [Define if strtof is broken.])
+fi])
+
+dnl Check whether strtod is broken.
+dnl The most common problem is that it does not convert "nan", "inf"
+dnl and "infinity".
+AC_DEFUN([LIBGFOR_CHECK_FOR_BROKEN_STRTOD], [
+ AC_CACHE_CHECK([whether strtod is broken],
+ have_broken_strtod, [
+ libgfor_check_for_broken_strtod_save_LIBS=$LIBS
+ LIBS="$LIBS -lm"
+ AC_TRY_RUN([
+#include <stdlib.h>
+int main ()
+{
+ double a;
+ a = strtod ("nan", NULL); if(a == a) return 1;
+ a = strtod("+inf", NULL); if(a != a || a != a + 1.0 || a < 0.0) return 1;
+ a = strtod("-inf", NULL); if(a != a || a != a - 1.0 || a > 0.0) return 1;
+ return 0;
+}], have_broken_strtod=no, have_broken_strtod=yes, [
+case "${target}" in
+ hppa*-*-hpux10*) have_broken_strtod=yes ;;
+ *) have_broken_strtod=no ;;
+esac])]
+ LIBS=$libgfor_check_for_broken_strtod_save_LIBS)
+if test x"$have_broken_strtod" = xyes; then
+ AC_DEFINE(HAVE_BROKEN_STRTOD, 1, [Define if strtod is broken.])
+fi])
+
+dnl Check whether strtold is broken.
+dnl The most common problem is that it does not convert "nan", "inf"
+dnl and "infinity".
+AC_DEFUN([LIBGFOR_CHECK_FOR_BROKEN_STRTOLD], [
+ AC_CACHE_CHECK([whether strtold is broken],
+ have_broken_strtold, [
+ libgfor_check_for_broken_strtold_save_LIBS=$LIBS
+ LIBS="$LIBS -lm"
+ AC_TRY_RUN([
+#include <stdlib.h>
+int main ()
+{
+#if HAVE_STRTOLD
+ long double a;
+ a = strtold ("nan", NULL); if(a == a) return 1;
+ a = strtold("+inf", NULL); if(a != a || a != a + 1.0 || a < 0.0) return 1;
+ a = strtold("-inf", NULL); if(a != a || a != a - 1.0 || a > 0.0) return 1;
+#endif
+ return 0;
+}], have_broken_strtold=no, have_broken_strtold=yes, [
+case "${target}" in
+ hppa*-*-hpux10*) have_broken_strtod=yes ;;
+ *) have_broken_strtold=no ;;
+esac])]
+ LIBS=$libgfor_check_for_broken_strtold_save_LIBS)
+if test x"$have_broken_strtold" = xyes; then
+ AC_DEFINE(HAVE_BROKEN_STRTOLD, 1, [Define if strtold is broken.])
+fi])
+
dnl Check whether isfinite is broken.
dnl The most common problem is that it does not work on long doubles.
AC_DEFUN([LIBGFOR_CHECK_FOR_BROKEN_ISFINITE], [
Index: io/read.c
===================================================================
--- io/read.c (revision 133994)
+++ io/read.c (working copy)
@@ -34,6 +34,12 @@
#include <ctype.h>
#include <stdlib.h>
+static int nan_p (const char *) __attribute__((unused));
+static int inf_p (const char *) __attribute__((unused));
+#if defined(HAVE_STRTOLD)
+static long double gfc_strtold (const char *, char **) __attribute__((unused));
+#endif
+
/* read.c -- Deal with formatted reads */
/* set_integer()-- All of the integer assignments come here to
@@ -127,8 +133,155 @@
/* 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. */
+
+/* Return 1 if the string S matches the string "nan" irrespective of case;
+ otherwise return 0. */
+static int
+nan_p (const char *s)
+{
+ if (*s != 'n' && *s != 'N')
+ return 0;
+
+ s++;
+ if (*s != 'a' && *s != 'A')
+ return 0;
+
+ s++;
+ if (*s != 'n' && *s != 'N')
+ return 0;
+
+ s++;
+ if (*s != 0)
+ return 0;
+
+ return 1;
+}
+
+/* Return 1 if the string S matches either the string "inf" or the string
+ "infinity" irrespective of case; otherwise return 0. */
+static int
+inf_p (const char *s)
+{
+ if (*s != 'i' && *s != 'I')
+ return 0;
+
+ s++;
+ if (*s != 'n' && *s != 'N')
+ return 0;
+
+ s++;
+ if (*s != 'f' && *s != 'F')
+ return 0;
+
+ s++;
+ if (*s == 0)
+ return 1;
+
+ if (*s != 'i' && *s != 'I')
+ return 0;
+
+ s++;
+ if (*s != 'n' && *s != 'N')
+ return 0;
+
+ s++;
+ if (*s != 'i' && *s != 'I')
+ return 0;
+
+ s++;
+ if (*s != 't' && *s != 'T')
+ return 0;
+
+ s++;
+ if (*s != 'y' && *s != 'Y')
+ return 0;
+
+ s++;
+ if (*s != 0)
+ return 0;
+
+ return 1;
+}
+
+static float
+gfc_strtof (const char *s, char **p)
+{
+#if ((defined(HAVE_STRTOF) && defined(HAVE_BROKEN_STRTOF)) \
+ || defined(HAVE_BROKEN_STRTOD))
+ const char *s1 = s;
+ int plus = 1;
+
+ if (*s1 == '+')
+ s1++;
+ else if (*s == '-')
+ {
+ s1++;
+ plus = 0;
+ }
+
+ if (nan_p (s1))
+ return plus ? __builtin_nanf ("") : -__builtin_nanf ("");
+ else if (inf_p (s1))
+ return plus ? __builtin_inff () : -__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_BROKEN_STRTOD)
+ const char *s1 = s;
+ int plus = 1;
+
+ if (*s1 == '+')
+ s1++;
+ else if (*s == '-')
+ {
+ s1++;
+ plus = 0;
+ }
+
+ if (nan_p (s1))
+ return plus ? __builtin_nan ("") : -__builtin_nan ("");
+ else if (inf_p (s1))
+ return plus ? __builtin_inf () : -__builtin_inf ();
+#endif
+
+ return strtod (s, p);
+}
+
+#if defined(HAVE_STRTOLD)
+static long double
+gfc_strtold (const char *s, char **p)
+{
+#if defined(HAVE_BROKEN_STRTOLD)
+ const char *s1 = s;
+ int plus = 1;
+
+ if (*s1 == '+')
+ s1++;
+ else if (*s == '-')
+ {
+ s1++;
+ plus = 0;
+ }
+
+ if (nan_p (s1))
+ return plus ? __builtin_nanl ("") : -__builtin_nanl ("");
+ else if (inf_p (s1))
+ return plus ? __builtin_infl () : -__builtin_infl ();
+#endif
+
+ return strtold (s, p);
+}
+#endif
int
convert_real (st_parameter_dt *dtp, void *dest, const char *buffer, int length)
@@ -139,25 +292,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;
@@ -165,7 +313,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;
More information about the Fortran
mailing list