re PR libfortran/34209 (run-time lib: NEAREST(0.0_8, -1.0) produces wrong numbers)

2007-11-23  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/34209
	* iresolve.c (gfc_resolve_nearest): If sign variable kind does not match
	kind of input variable, convert it to match.

	PR fortran/33317
	* trans.h: Modify prototype for gfc_conv_missing_dummy.
	* trans-expr.c (gfc_conv_missing_dummy): Modify to pass an integer kind
	parameter in.  Set the type of the dummy to the kind given.
	(gfc_conv_function_call): Pass representation.length to
	gfc_conv_missing_dummy.
	* iresolve.c (gfc_resolve_cshift): Determine the correct kind to use and
	if appropriate set representation.length to this kind value.
	(gfc_resolve_eoshift): Likewise.
	* check.c (gfc_check_cshift): Enable dim_check to allow DIM as an
	optional argument. (gfc_check_eoshift): Likewise.
	* trans_intrinsic.c (gfc_conv_intrinsic_function_args): Update call to
	gfc_conv_missing_dummy.

From-SVN: r130391

1 files changed, 50 insertions, 21 deletions

diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index e685a0a..b847044 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -559,7 +559,7 @@ void
 gfc_resolve_cshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
 		    gfc_expr *dim)
 {
-  int n;
+  int n, m;
 
   if (array->ts.type == BT_CHARACTER && array->ref)
     gfc_resolve_substring_charlen (array);
@@ -573,22 +573,35 @@ gfc_resolve_cshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
   else
     n = 0;
 
-  /* Convert shift to at least gfc_default_integer_kind, so we don't need
-     kind=1 and kind=2 versions of the library functions.  */
-  if (shift->ts.kind < gfc_default_integer_kind)
+  /* If dim kind is greater than default integer we need to use the larger.  */
+  m = gfc_default_integer_kind;
+  if (dim != NULL)
+    m = m < dim->ts.kind ? dim->ts.kind : m;
+  
+  /* Convert shift to at least m, so we don't need
+      kind=1 and kind=2 versions of the library functions.  */
+  if (shift->ts.kind < m)
     {
       gfc_typespec ts;
       ts.type = BT_INTEGER;
-      ts.kind = gfc_default_integer_kind;
+      ts.kind = m;
       gfc_convert_type_warn (shift, &ts, 2, 0);
     }
-
+ 
   if (dim != NULL)
     {
-      gfc_resolve_dim_arg (dim);
-      /* Convert dim to shift's kind, so we don't need so many variations.  */
-      if (dim->ts.kind != shift->ts.kind)
-	gfc_convert_type_warn (dim, &shift->ts, 2, 0);
+      if (dim->expr_type != EXPR_CONSTANT)
+	{
+	  /* Mark this for later setting the type in gfc_conv_missing_dummy.  */
+	  dim->representation.length = shift->ts.kind;
+	}
+      else
+	{
+	  gfc_resolve_dim_arg (dim);
+	  /* Convert dim to shift's kind to reduce variations.  */
+	  if (dim->ts.kind != shift->ts.kind)
+	    gfc_convert_type_warn (dim, &shift->ts, 2, 0);
+        }
     }
 
   f->value.function.name
@@ -683,7 +696,7 @@ void
 gfc_resolve_eoshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
 		     gfc_expr *boundary, gfc_expr *dim)
 {
-  int n;
+  int n, m;
 
   if (array->ts.type == BT_CHARACTER && array->ref)
     gfc_resolve_substring_charlen (array);
@@ -698,22 +711,35 @@ gfc_resolve_eoshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
   if (boundary && boundary->rank > 0)
     n = n | 2;
 
-  /* Convert shift to at least gfc_default_integer_kind, so we don't need
-     kind=1 and kind=2 versions of the library functions.  */
-  if (shift->ts.kind < gfc_default_integer_kind)
+  /* If dim kind is greater than default integer we need to use the larger.  */
+  m = gfc_default_integer_kind;
+  if (dim != NULL)
+    m = m < dim->ts.kind ? dim->ts.kind : m;
+  
+  /* Convert shift to at least m, so we don't need
+      kind=1 and kind=2 versions of the library functions.  */
+  if (shift->ts.kind < m)
     {
       gfc_typespec ts;
       ts.type = BT_INTEGER;
-      ts.kind = gfc_default_integer_kind;
+      ts.kind = m;
       gfc_convert_type_warn (shift, &ts, 2, 0);
     }
-
+ 
   if (dim != NULL)
     {
-      gfc_resolve_dim_arg (dim);
-      /* Convert dim to shift's kind, so we don't need so many variations.  */
-      if (dim->ts.kind != shift->ts.kind)
-	gfc_convert_type_warn (dim, &shift->ts, 2, 0);
+      if (dim->expr_type != EXPR_CONSTANT)
+	{
+	  /* Mark this for later setting the type in gfc_conv_missing_dummy.  */
+	  dim->representation.length = shift->ts.kind;
+	}
+      else
+	{
+	  gfc_resolve_dim_arg (dim);
+	  /* Convert dim to shift's kind to reduce variations.  */
+	  if (dim->ts.kind != shift->ts.kind)
+	    gfc_convert_type_warn (dim, &shift->ts, 2, 0);
+        }
     }
 
   f->value.function.name
@@ -1580,8 +1606,11 @@ gfc_resolve_modulo (gfc_expr *f, gfc_expr *a, gfc_expr *p)
 }
 
 void
-gfc_resolve_nearest (gfc_expr *f, gfc_expr *a, gfc_expr *p ATTRIBUTE_UNUSED)
+gfc_resolve_nearest (gfc_expr *f, gfc_expr *a, gfc_expr *p)
 {
+  if (p->ts.kind != a->ts.kind)
+    gfc_convert_type (p, &a->ts, 2);
+
   f->ts = a->ts;
   f->value.function.name
     = gfc_get_string ("__nearest_%c%d", gfc_type_letter (a->ts.type),