On Thu, Apr 07, 2005 at 07:14:05PM +0100, Paul Brook wrote:
> On Thursday 07 April 2005 18:54, Steve Kargl wrote:
> > On Thu, Apr 07, 2005 at 01:41:21PM -0400, Geert Bosch wrote:
> > > On Apr 7, 2005, at 13:27, Steve Kargl wrote:
> > > >Try -fdump-parse-tree. You've given more digits in y than
> > > >its precision. This is permitted by the standard. It appears
> > > >the gfortran frontend is taking y = 0.499999 and the closest
> > > >representable nubmer is y = 0.5.
> > >
> > > So, why does the test y < 0.5 yield true then?
> >
> > I missed that part of the output. The exceeding
> > long string of digits caught my attention. Can
> > you submit a PR? The problem, I believe, is in
> > gfc_simplify_nint
>
> Unlikely, although that may also be buggy. fc_simplify_* only applies to
> compile time costants. You probably want build_round_expr in
> trans-intrinsic.c
>
It's buggy. If I have time this weekend, I'll check build_round_expr.
Meanwhile, the attached patch and testcase fix the problem with gfortran's
constant folding. Bubblestrapped and Regression tested on mainline
for amd64-*-freebsd.
Ok to commit to mainline? Ok to commit to 4.0 after strapping
and testing?
2005-04-08 Steven G. Kargl <[EMAIL PROTECTED]>
* simplify.c (simplify_nint): Fix rounding for corner cases
2005-04-08 Steven G. Kargl <[EMAIL PROTECTED]>
* gfortran.dg/nint_1.f90: New test.
--
Steve
Index: simplify.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/simplify.c,v
retrieving revision 1.21
diff -c -p -r1.21 simplify.c
*** simplify.c 7 Apr 2005 18:26:37 -0000 1.21
--- simplify.c 8 Apr 2005 17:52:43 -0000
*************** gfc_simplify_nearest (gfc_expr * x, gfc_
*** 2378,2386 ****
static gfc_expr *
simplify_nint (const char *name, gfc_expr * e, gfc_expr * k)
{
! gfc_expr *rtrunc, *itrunc, *result;
! int kind, cmp;
! mpfr_t half;
kind = get_kind (BT_INTEGER, k, name, gfc_default_integer_kind);
if (kind == -1)
--- 2378,2385 ----
static gfc_expr *
simplify_nint (const char *name, gfc_expr * e, gfc_expr * k)
{
! gfc_expr *itrunc, *result;
! int kind;
kind = get_kind (BT_INTEGER, k, name, gfc_default_integer_kind);
if (kind == -1)
*************** simplify_nint (const char *name, gfc_exp
*** 2391,2423 ****
result = gfc_constant_result (BT_INTEGER, kind, &e->where);
- rtrunc = gfc_copy_expr (e);
itrunc = gfc_copy_expr (e);
! cmp = mpfr_cmp_ui (e->value.real, 0);
!
! gfc_set_model (e->value.real);
! mpfr_init (half);
! mpfr_set_str (half, "0.5", 10, GFC_RND_MODE);
!
! if (cmp > 0)
! {
! mpfr_add (rtrunc->value.real, e->value.real, half, GFC_RND_MODE);
! mpfr_trunc (itrunc->value.real, rtrunc->value.real);
! }
! else if (cmp < 0)
! {
! mpfr_sub (rtrunc->value.real, e->value.real, half, GFC_RND_MODE);
! mpfr_trunc (itrunc->value.real, rtrunc->value.real);
! }
! else
! mpfr_set_ui (itrunc->value.real, 0, GFC_RND_MODE);
gfc_mpfr_to_mpz (result->value.integer, itrunc->value.real);
gfc_free_expr (itrunc);
- gfc_free_expr (rtrunc);
- mpfr_clear (half);
return range_check (result, name);
}
--- 2390,2402 ----
result = gfc_constant_result (BT_INTEGER, kind, &e->where);
itrunc = gfc_copy_expr (e);
! mpfr_round(itrunc->value.real, e->value.real);
gfc_mpfr_to_mpz (result->value.integer, itrunc->value.real);
gfc_free_expr (itrunc);
return range_check (result, name);
}
program nint_1
if (int(nint(8388609.0)) /= 8388609) call abort
if (int(nint(0.49999997)) /= 0) call abort
end program nint_1
