diff options
| author | Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> | 2007-08-05 22:14:34 +0000 |
|---|---|---|
| committer | François-Xavier Coudert <fxcoudert@gcc.gnu.org> | 2007-08-05 22:14:34 +0000 |
| commit | c120ef140a61483e238229e690486821b4375330 (patch) | |
| tree | f504b2d268647874e55d8ef70dee853132ef178d /libgfortran/intrinsics/c99_functions.c | |
| parent | 9dfbac5b94278cac26c43986553827e0fe4adc8e (diff) | |
| download | gcc-c120ef140a61483e238229e690486821b4375330.zip gcc-c120ef140a61483e238229e690486821b4375330.tar.gz gcc-c120ef140a61483e238229e690486821b4375330.tar.bz2 | |
re PR fortran/31202 (Incorrect rounding generated for NINT)
2007-08-05 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/31202
* intrinsics/c99_functions.c (roundl): Provide fallback
implementation for systems without ceill.
* c99_protos.h (roundl): Define prototype in all cases.
From-SVN: r127227
Diffstat (limited to 'libgfortran/intrinsics/c99_functions.c')
| -rw-r--r-- | libgfortran/intrinsics/c99_functions.c | 24 |
1 files changed, 23 insertions, 1 deletions
diff --git a/libgfortran/intrinsics/c99_functions.c b/libgfortran/intrinsics/c99_functions.c index e36c5ba..65c284e 100644 --- a/libgfortran/intrinsics/c99_functions.c +++ b/libgfortran/intrinsics/c99_functions.c @@ -500,8 +500,9 @@ powf(float x, float y) /* Algorithm by Steven G. Kargl. */ -#if !defined(HAVE_ROUNDL) && defined(HAVE_CEILL) +#if !defined(HAVE_ROUNDL) #define HAVE_ROUNDL 1 +#if defined(HAVE_CEILL) /* Round to nearest integral value. If the argument is halfway between two integral values then round away from zero. */ @@ -527,6 +528,27 @@ roundl(long double x) return (-t); } } +#else + +/* Poor version of roundl for system that don't have ceill. */ +long double +roundl(long double x) +{ + if (x > DBL_MAX || x < -DBL_MAX) + { +#ifdef HAVE_NEXTAFTERL + static long double prechalf = nexafterl (0.5L, LDBL_MAX); +#else + static long double prechalf = 0.5L; +#endif + return (GFC_INTEGER_LARGEST) (x + (x > 0 ? prechalf : -prechalf)); + } + else + /* Use round(). */ + return round((double) x); +} + +#endif #endif #ifndef HAVE_ROUND |