From: Tobias Schlüter <tobias.schlueter@physik.uni-muenchen.de>
Date: Fri, 14 May 2004 13:51:27 +0000 (+0200)
Subject: re PR fortran/15205 (NEAREST intrinsic returns wrong value in DOUBLE PRECISION)
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=8765339d0b13e84a05d615392655a9b13a604b4a;p=gcc.git

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 9e3741a83f5..f5dd778b1ab 100644
--- 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 bfbf33f308c..c787e227a4e 100644
--- 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 29041bc4566..fa39a3e4234 100644
--- 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 68abc94de26..e873f03f0dc 100644
--- 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)