re PR fortran/15205 (NEAREST intrinsic returns wrong value in DOUBLE PRECISION)

PR fortran/15205
* iresolve.c (gfc_resolve_nearest): Add new function.
* intrinsic.h: ... declare it here.
* intrinsic.c (add_functions): ... add it as resolving function
for NEAREST.

From-SVN: r81843
This commit is contained in:
Tobias Schlüter 2004-05-14 15:51:27 +02:00 committed by Tobias Schlüter
parent 9b089e0545
commit 8765339d0b
4 changed files with 20 additions and 1 deletions

View File

@ -1,3 +1,11 @@
2004-05-14 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
PR fortran/15205
* iresolve.c (gfc_resolve_nearest): Add new function.
* intrinsic.h: ... declare it here.
* intrinsic.c (add_functions): ... add it as resolving function
for NEAREST.
2004-05-14 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
PR fortran/14066

View File

@ -1301,7 +1301,7 @@ add_functions (void)
make_generic ("modulo", GFC_ISYM_MODULO);
add_sym_2 ("nearest", 1, 1, BT_REAL, dr,
gfc_check_nearest, gfc_simplify_nearest, NULL,
gfc_check_nearest, gfc_simplify_nearest, gfc_resolve_nearest,
x, BT_REAL, dr, 0, s, BT_REAL, dr, 0);
make_generic ("nearest", GFC_ISYM_NEAREST);

View File

@ -270,6 +270,7 @@ void gfc_resolve_minloc (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_minval (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_mod (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_modulo (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_nearest (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_nint (gfc_expr *, gfc_expr *, gfc_expr *);
void gfc_resolve_not (gfc_expr *, gfc_expr *);
void gfc_resolve_pack (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);

View File

@ -911,6 +911,16 @@ gfc_resolve_modulo (gfc_expr * f, gfc_expr * a,
a->ts.kind);
}
void
gfc_resolve_nearest (gfc_expr * f, gfc_expr * a,
gfc_expr *p ATTRIBUTE_UNUSED)
{
f->ts = a->ts;
f->value.function.name =
gfc_get_string ("__nearest_%c%d", gfc_type_letter (a->ts.type),
a->ts.kind);
}
void
gfc_resolve_nint (gfc_expr * f, gfc_expr * a, gfc_expr * kind)