From c2b2130c71a0cb068077e5c6bc4260d04974b37b Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Mon, 3 Jun 2013 11:20:46 +0200 Subject: [PATCH] re PR libfortran/57496 (I/O: WRITE(*,*) HUGE(0._10) gives SIGFPE with -ffpe-trap=overflow) 2013-06-01 Tobias Burnus PR fortran/57496 * io/write_float.def (ISFINITE2Q, ISFINITE2, ISFINITE2L, * ISFINITE, SIGNBIT2Q, SIGNBIT2, SIGNBIT2L, SIGNBIT, ISNAN2Q, ISNAN2, ISNAN2L, ISNAN): New macros. (output_float_FMT_G_,WRITE_FLOAT): Use them. From-SVN: r199598 --- libgfortran/ChangeLog | 40 ++++++++++++++++++++-------------- libgfortran/io/write_float.def | 36 ++++++++++++++++++++++++++---- 2 files changed, 56 insertions(+), 20 deletions(-) diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 59ac4da949f..38a53190179 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,11 @@ +2013-06-01 Tobias Burnus + + PR fortran/57496 + * io/write_float.def (ISFINITE2Q, ISFINITE2, ISFINITE2L, ISFINITE, + SIGNBIT2Q, SIGNBIT2, SIGNBIT2L, SIGNBIT, ISNAN2Q, ISNAN2, ISNAN2L, + ISNAN): New macros. + (output_float_FMT_G_,WRITE_FLOAT): Use them. + 2013-05-24 Rainer Orth * acinclude.m4 (libgfor_cv_have_as_needed): Check for -z ignore, too. @@ -19,25 +27,25 @@ 2013-04-29 Janne Blomqvist - * intrinsics/system_clock (gf_gettime_mono): Use variable - resolution for fractional seconds argument. - (system_clock_4): Simplify, update for gf_gettime_mono change. - (system_clock_8): Likewise. + * intrinsics/system_clock (gf_gettime_mono): Use variable + resolution for fractional seconds argument. + (system_clock_4): Simplify, update for gf_gettime_mono change. + (system_clock_8): Likewise. 2013-04-29 Janne Blomqvist - PR fortran/56981 - * io/transfer.c (next_record_w_unf): First fix head marker, then - write tail. - (next_record): Call flush_if_unbuffered. - * io/unix.c (struct unix_stream): Add field unbuffered. - (flush_if_unbuffered): New function. - (fd_to_stream): New argument. - (open_external): Fix fd_to_stream call. - (input_stream): Likewise. - (output_stream): Likewise. - (error_stream): Likewise. - * io/unix.h (flush_if_unbuffered): New prototype. + PR fortran/56981 + * io/transfer.c (next_record_w_unf): First fix head marker, then + write tail. + (next_record): Call flush_if_unbuffered. + * io/unix.c (struct unix_stream): Add field unbuffered. + (flush_if_unbuffered): New function. + (fd_to_stream): New argument. + (open_external): Fix fd_to_stream call. + (input_stream): Likewise. + (output_stream): Likewise. + (error_stream): Likewise. + * io/unix.h (flush_if_unbuffered): New prototype. 2013-04-28 Janne Blomqvist diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def index a157f0b6328..b634ff54f0b 100644 --- a/libgfortran/io/write_float.def +++ b/libgfortran/io/write_float.def @@ -961,6 +961,34 @@ __qmath_(quadmath_snprintf) (buffer, size, "%+-#.*Qf", \ #endif +#if defined(GFC_REAL_16_IS_FLOAT128) +#define ISFINITE2Q(val) finiteq(val) +#endif +#define ISFINITE2(val) isfinite(val) +#define ISFINITE2L(val) isfinite(val) + +#define ISFINITE(suff,val) TOKENPASTE(ISFINITE2,suff)(val) + + +#if defined(GFC_REAL_16_IS_FLOAT128) +#define SIGNBIT2Q(val) signbitq(val) +#endif +#define SIGNBIT2(val) signbit(val) +#define SIGNBIT2L(val) signbit(val) + +#define SIGNBIT(suff,val) TOKENPASTE(SIGNBIT2,suff)(val) + + +#if defined(GFC_REAL_16_IS_FLOAT128) +#define ISNAN2Q(val) isnanq(val) +#endif +#define ISNAN2(val) isnan(val) +#define ISNAN2L(val) isnan(val) + +#define ISNAN(suff,val) TOKENPASTE(ISNAN2,suff)(val) + + + /* Generate corresponding I/O format for FMT_G and output. The rules to translate FMT_G to FMT_E or FMT_F from DEC fortran LRM (table 11-2, Chapter 11, "I/O Formatting", P11-25) is: @@ -1127,7 +1155,7 @@ OUTPUT_FLOAT_FMT_G(16,L) {\ GFC_REAL_ ## x tmp; \ tmp = * (GFC_REAL_ ## x *)source; \ - if (isfinite (tmp)) \ + if (ISFINITE (y,tmp)) \ nprinted = DTOA(y,0,tmp); \ else\ nprinted = -1;\ @@ -1194,10 +1222,10 @@ determine_en_precision (st_parameter_dt *dtp, const fnode *f, {\ GFC_REAL_ ## x tmp;\ tmp = * (GFC_REAL_ ## x *)source;\ - sign_bit = signbit (tmp);\ - if (!isfinite (tmp))\ + sign_bit = SIGNBIT (y,tmp);\ + if (!ISFINITE (y,tmp))\ { \ - write_infnan (dtp, f, isnan (tmp), sign_bit);\ + write_infnan (dtp, f, ISNAN (y,tmp), sign_bit);\ return;\ }\ tmp = sign_bit ? -tmp : tmp;\ -- 2.30.2