This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[gfortran] patch for output of real values on windows systems
- From: FX Coudert <fxcoudert at gmail dot com>
- To: gfortran <fortran at gcc dot gnu dot org>, patch <gcc-patches at gcc dot gnu dot org>
- Date: Fri, 05 Aug 2005 23:59:36 +0200
- Subject: [gfortran] patch for output of real values on windows systems
Attached patch (comes with ChangeLog) fixes PR libfortran/23138: the
system sprintf (that is, the one included in msvcrt.dll) is not able to
handle long double values (thanks to Danny Smith for the diagnosis!).
Thus, this patch provides a fallback implementation in that precise case
(that is, the format is fixed: "%+-#31.*Le", which makes it easy to
implement). The patch adds a test in aclocal.m4 (with reasonnable guess
based on ${target} for cross-compilers) to know if sprintf is to be used
or the fallback.
The provided fallback sprintf is not perfect: it prints incorrect last
digits (at least, not similar to those printed by GNU libc) when used to
output very large or very small long double values with high precision
(more than 15 digits). Any practical suggestion on this is welcome.
Patch was tested as follows:
* the poor_sprintf() function was checked standalone and compared to
GNU libc on random floating point values, as well as corner cases
(infinity, LDBL_MAX, very close to LDBL_MAX, 1.0, very close to 1.0,
very close to 0.0, 0.0, ...)
* the total patch was built and tested on i386-mingw32. That does not
include full regtesting, since the dejagnu framework doesn't work on
i386-mingw32, but I manually ran some of the many testcases which failed
before, such as the one in the PR and large_real_1.f90.
* the total patch was built and regtested on i686-linux.
* I checked that the configure test performed well on: i386-mingw32,
i686-linux, x86_64-linux as well as a cross compiler with
build=host=x86_64-linux and target=i386-mingw32.
OK to commit?
FX
PS: the Windows binaries I post to my website (and which are linked from
gfortran.org) will be built with this patch. gfortran on windows is
simply unusable without it.
:ADDPATCH libgfortran:
Index: libgfortran/acinclude.m4
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/acinclude.m4,v
retrieving revision 1.5
diff -u -3 -p -r1.5 acinclude.m4
--- libgfortran/acinclude.m4 12 Dec 2004 08:59:01 -0000 1.5
+++ libgfortran/acinclude.m4 2 Aug 2005 16:56:57 -0000
@@ -148,3 +148,30 @@ extern void bar(void) __attribute__((ali
AC_DEFINE(HAVE_ATTRIBUTE_ALIAS, 1,
[Define to 1 if the target supports __attribute__((alias(...))).])
fi])
+
+dnl Check whether support for long double in printf works correctly.
+AC_DEFUN([LIBGFOR_CHECK_PRINTF_LONGDOUBLE], [
+ AC_CACHE_CHECK([whether the target support correctly long doubles in printf],
+ have_printf_longdouble, [
+ AC_TRY_RUN([
+#include <stdio.h>
+#include <string.h>
+
+int main ()
+{
+ char s[30];
+ long double x = 127.84L;
+
+ sprintf (s, "%14.5Le", x);
+ if (strncmp (s, " 1.27840e+02", 14) == 0)
+ return 0;
+ else
+ return 1;
+}], have_printf_longdouble=yes, have_printf_longdouble=no, [
+case "${target}" in
+ *mingw*) have_printf_longdouble=no ;;
+ *) have_printf_longdouble=yes;;
+esac])])
+if test x"$have_printf_longdouble" = xyes; then
+ AC_DEFINE(HAVE_PRINTF_LONGDOUBLE, 1, [Define if printf supports long doubles correctly.])
+fi])
Index: libgfortran/config.h.in
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/config.h.in,v
retrieving revision 1.22
diff -u -3 -p -r1.22 config.h.in
--- libgfortran/config.h.in 24 Jun 2005 23:07:13 -0000 1.22
+++ libgfortran/config.h.in 2 Aug 2005 16:56:57 -0000
@@ -174,6 +174,9 @@
/* libm includes powf */
#undef HAVE_POWF
+/* Define if printf supports long doubles correctly. */
+#undef HAVE_PRINTF_LONGDOUBLE
+
/* libm includes round */
#undef HAVE_ROUND
Index: libgfortran/configure
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/configure,v
retrieving revision 1.40
diff -u -3 -p -r1.40 configure
--- libgfortran/configure 24 Jun 2005 23:07:13 -0000 1.40
+++ libgfortran/configure 2 Aug 2005 16:56:57 -0000
@@ -12317,6 +12317,76 @@ _ACEOF
fi
+# Check whether printf supports long doubles correctly.
+
+ echo "$as_me:$LINENO: checking whether the target support correctly long doubles in printf" >&5
+echo $ECHO_N "checking whether the target support correctly long doubles in printf... $ECHO_C" >&6
+if test "${have_printf_longdouble+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+
+ if test "$cross_compiling" = yes; then
+
+case "${target}" in
+ *mingw*) have_printf_longdouble=no ;;
+ *) have_printf_longdouble=yes;;
+esac
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+#include <stdio.h>
+#include <string.h>
+
+int main ()
+{
+ char s[30];
+ long double x = 127.84L;
+
+ sprintf (s, "%14.5Le", x);
+ if (strncmp (s, " 1.27840e+02", 14) == 0)
+ return 0;
+ else
+ return 1;
+}
+_ACEOF
+rm -f conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } && { ac_try='./conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ have_printf_longdouble=yes
+else
+ echo "$as_me: program exited with status $ac_status" >&5
+echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+( exit $ac_status )
+have_printf_longdouble=no
+fi
+rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
+fi
+fi
+echo "$as_me:$LINENO: result: $have_printf_longdouble" >&5
+echo "${ECHO_T}$have_printf_longdouble" >&6
+if test x"$have_printf_longdouble" = xyes; then
+
+cat >>confdefs.h <<\_ACEOF
+#define HAVE_PRINTF_LONGDOUBLE 1
+_ACEOF
+
+fi
+
cat >confcache <<\_ACEOF
# This file is a shell script that caches the results of configure
# tests run on this system so they can be shared between configure
Index: libgfortran/configure.ac
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/configure.ac,v
retrieving revision 1.30
diff -u -3 -p -r1.30 configure.ac
--- libgfortran/configure.ac 24 Jun 2005 23:07:13 -0000 1.30
+++ libgfortran/configure.ac 2 Aug 2005 16:56:57 -0000
@@ -258,6 +258,9 @@ LIBGFOR_CHECK_ATTRIBUTE_VISIBILITY
LIBGFOR_CHECK_ATTRIBUTE_DLLEXPORT
LIBGFOR_CHECK_ATTRIBUTE_ALIAS
+# Check whether printf supports long doubles correctly.
+LIBGFOR_CHECK_PRINTF_LONGDOUBLE
+
AC_CACHE_SAVE
if test ${multilib} = yes; then
Index: libgfortran/io/io.h
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/io/io.h,v
retrieving revision 1.22
diff -u -3 -p -r1.22 io.h
--- libgfortran/io/io.h 14 Jul 2005 06:21:58 -0000 1.22
+++ libgfortran/io/io.h 2 Aug 2005 16:56:57 -0000
@@ -647,4 +647,7 @@ internal_proto(write_z);
extern void list_formatted_write (bt, void *, int);
internal_proto(list_formatted_write);
+extern void poor_sprintf (long double, char *, const int, double);
+internal_proto(poor_sprintf);
+
#endif
Index: libgfortran/io/write.c
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/io/write.c,v
retrieving revision 1.45
diff -u -3 -p -r1.45 write.c
--- libgfortran/io/write.c 30 Jul 2005 20:45:02 -0000 1.45
+++ libgfortran/io/write.c 2 Aug 2005 16:56:58 -0000
@@ -314,6 +314,106 @@ calculate_G_format (fnode *f, GFC_REAL_L
}
+void poor_sprintf (long double x, char * buffer, const int n, double logval)
+{
+ int log, i, j;
+ char *c;
+
+ *(buffer++) = (x < 0 ? '-' : '+');
+
+ if (logval < 0)
+ log = ((int) logval) - 1;
+ else
+ log = (int) logval;
+
+ x = (x < 0 ? -x : x);
+ if (x != 0 && x < 1)
+ {
+ while (x < 1e-1000L)
+ x *= 1e1000L;
+ while (x < 1e-100L)
+ x *= 1e100L;
+ while (x < 1e-10L)
+ x *= 1e10L;
+ while (x < 1)
+ x *= 10;
+ }
+ else
+ {
+ while (x > 1e1000L)
+ x *= 1e-1000L;
+ while (x > 1e100L)
+ x *= 1e-100L;
+ while (x > 1e10L)
+ x *= 1e-10L;
+ while (x >= 10)
+ x /= 10;
+ }
+ *(buffer++) = '0' + (int) x;
+ *(buffer++) = '.';
+
+ i = 0;
+ while (i < n)
+ {
+ i++;
+ x = (x - (int) x) * 10;
+ *(buffer++) = '0' + (int) x;
+ }
+
+ /* Rounding */
+ x = (x - (int) x) * 10;
+ c = buffer - 1;
+ if ((int) x >= 5)
+ {
+ while (*c != '.')
+ {
+ if (*c == '9')
+ *c = '0';
+ else
+ {
+ (*c)++;
+ break;
+ }
+ c--;
+ }
+
+ if (*c == '.')
+ {
+ /* We encounter the decimal separator during backward propagation
+ of the rounding. */
+ c--;
+ if (*c != '9')
+ (*c)++;
+ else
+ {
+ *c = '1';
+ log += 1;
+ }
+ }
+ }
+
+ *(buffer++) = 'e';
+ *(buffer++) = (log < 0 ? '-' : '+');
+ if (log < 0)
+ log = -log;
+
+ if (log > 10000)
+ i = 5;
+ else if (log > 1000)
+ i = 4;
+ else if (log > 100)
+ i = 3;
+ else
+ i = 2;
+
+ for (j = 1; j <= i; j++)
+ {
+ buffer[i-j] = '0' + (log % 10);
+ log /= 10;
+ }
+}
+
+
/* Output a real number according to its format which is FMT_G free. */
static void
@@ -342,7 +442,7 @@ output_float (fnode *f, GFC_REAL_LARGEST
int nblanks;
int i;
sign_t sign;
- double abslog;
+ double logval, abslog;
ft = f->format;
w = f->u.real.w;
@@ -368,10 +468,11 @@ output_float (fnode *f, GFC_REAL_LARGEST
else
{
#if defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)
- abslog = fabs((double) log10l(value));
+ logval = (double) log10l(value);
#else
- abslog = fabs(log10(value));
+ logval = log10(value);
#endif
+ abslog = fabs(logval);
if (abslog < 100)
edigits = 2;
else
@@ -412,8 +513,12 @@ output_float (fnode *f, GFC_REAL_LARGEST
* equal to the precision. The exponent always contains at least two
* digits; if the value is zero, the exponent is 00.
*/
+#if (defined(HAVE_GFC_REAL_10) || defined(HAVE_GFC_REAL_16)) && !defined(HAVE_PRINTF_LONGDOUBLE)
+ poor_sprintf (value, buffer, ndigits - 1, logval);
+#else
sprintf (buffer, "%+-#31.*" GFC_REAL_LARGEST_FORMAT "e",
ndigits - 1, value);
+#endif
/* Check the resulting string has punctuation in the correct places. */
if (buffer[2] != '.' || buffer[ndigits + 2] != 'e')
2005-08-05 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR libfortran/23138
* acinclude.m4 (LIBGFOR_CHECK_PRINTF_LONGDOUBLE): Add check to see
if printf handles long double values correctly.
* configure.ac: Use this new test.
* config.h.in: Regenerate.
* configure: Regenerate.
* io/io.h: Add prototype for poor_sprintf.
* io/write.c (poor_sprintf): Provide a minimalist sprintf for
systems where sprintf doesn't handle long double values correctly.
(output_float): Use this new function if need be. Store log10(value)
instead of computing it twice in that case.