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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 9e3741a83f5ebd8a2748a6f7d59222eaa5ca31f8..f5dd778b1ab69cb5bf4b1917a3ae67f17b2c62a8 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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

diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index bfbf33f308c702a0006c9653741a8bcdcdb80427..c787e227a4eba68f64c83721ecd176ddbe5f666b 100644 (file)
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -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);

diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index 29041bc456628749037215ff30fd389585f3768c..fa39a3e4234ca4455c8188cf4e3f81b664ac642e 100644 (file)
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -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 *);

diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 68abc94de26941956a640dae3a5d469ba72576d2..e873f03f0dc834905eba7497a78d207377696b37 100644 (file)
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -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)