re PR libfortran/22143 (missing kinds 1 and 2 for eoshift and cshift)

2005-08-10  Thomas Koenig  <Thomas.Koenig@online.de>

	PR libfortran/22143
	gfortran.h:  Declare new function gfc_resolve_dim_arg.
	resolve.c:  New function gfc_resolve_dim_arg.
	iresolve.c (gfc_resolve_all):  Use gfc_resolve_dim_arg.
	(gfc_resolve_any):  Likewise.
	(gfc_resolve_count):  Likewise.
	(gfc_resolve_cshift):  Likewise.  If the kind of shift is less
	gfc_default_integer_kind, convert it to default integer type.
	(gfc_resolve_eoshift):  Likewise.
	(gfc_resolve_maxloc):  Use gfc_resolve_dim_arg.
	(gfc_resolve_maxval):  Likewise.
	(gfc_resolve_minloc):  Likewise.
	(gfc_resolve_minval):  Likewise.
	(gfc_resolve_product):  Likewise.
	(gfc_resolve_spread):  Likewise.
	(gfc_resolve_sum):  Likewise.

2005-08-10  Thomas Koenig  <Thomas.Koenig@online.de>

	PR libfortran/22143
	gfortran.dg/shift-kind.f90:  New testcase.

From-SVN: r102957

gcc/fortran/ChangeLog

+2005-08-10  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR libfortran/22143
+	gfortran.h:  Declare new function gfc_resolve_dim_arg.
+	resolve.c:  New function gfc_resolve_dim_arg.
+	iresolve.c (gfc_resolve_all):  Use gfc_resolve_dim_arg.
+	(gfc_resolve_any):  Likewise.
+	(gfc_resolve_count):  Likewise.
+	(gfc_resolve_cshift):  Likewise.  If the kind of shift is less
+	gfc_default_integer_kind, convert it to default integer type.
+	(gfc_resolve_eoshift):  Likewise.
+	(gfc_resolve_maxloc):  Use gfc_resolve_dim_arg.
+	(gfc_resolve_maxval):  Likewise.
+	(gfc_resolve_minloc):  Likewise.
+	(gfc_resolve_minval):  Likewise.
+	(gfc_resolve_product):  Likewise.
+	(gfc_resolve_spread):  Likewise.
+	(gfc_resolve_sum):  Likewise.
+
 2005-08-09  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
 	* check.c (gfc_check_ttynam_sub, gfc_check_isatty): Add check

gcc/fortran/gfortran.h

@@ -1779,6 +1779,7 @@ int gfc_pure (gfc_symbol *);
 int gfc_elemental (gfc_symbol *);
 try gfc_resolve_iterator (gfc_iterator *, bool);
 try gfc_resolve_index (gfc_expr *, int);
+try gfc_resolve_dim_arg (gfc_expr *);
 
 /* array.c */
 void gfc_free_array_spec (gfc_array_spec *);

gcc/fortran/iresolve.c

@@ -129,7 +129,7 @@ gfc_resolve_all (gfc_expr * f, gfc_expr * mask, gfc_expr * dim)
 
   if (dim != NULL)
     {
-      gfc_resolve_index (dim, 1);
+      gfc_resolve_dim_arg (dim);
       f->rank = mask->rank - 1;
       f->shape = gfc_copy_shape_excluding (mask->shape, mask->rank, dim);
     }
@@ -167,7 +167,7 @@ gfc_resolve_any (gfc_expr * f, gfc_expr * mask, gfc_expr * dim)
 
   if (dim != NULL)
     {
-      gfc_resolve_index (dim, 1);
+      gfc_resolve_dim_arg (dim);
       f->rank = mask->rank - 1;
       f->shape = gfc_copy_shape_excluding (mask->shape, mask->rank, dim);
     }
@@ -359,7 +359,7 @@ gfc_resolve_count (gfc_expr * f, gfc_expr * mask, gfc_expr * dim)
   if (dim != NULL)
     {
       f->rank = mask->rank - 1;
-      gfc_resolve_index (dim, 1);
+      gfc_resolve_dim_arg (dim);
       f->shape = gfc_copy_shape_excluding (mask->shape, mask->rank, dim);
     }
 
@@ -385,9 +385,19 @@ gfc_resolve_cshift (gfc_expr * f, gfc_expr * array,
   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)
+    {
+      gfc_typespec ts;
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_default_integer_kind;
+      gfc_convert_type_warn (shift, &ts, 2, 0);
+    }
+
   if (dim != NULL)
     {
-      gfc_resolve_index (dim, 1);
+      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);
@@ -474,10 +484,23 @@ gfc_resolve_eoshift (gfc_expr * f, gfc_expr * array,
   if (boundary && boundary->rank > 0)
     n = n | 2;
 
-  /* Convert dim to the same type as shift, so we don't need quite so many
-     variations.  */
-  if (dim != NULL && dim->ts.kind != shift->ts.kind)
-    gfc_convert_type_warn (dim, &shift->ts, 2, 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)
+    {
+      gfc_typespec ts;
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_default_integer_kind;
+      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);
+    }
 
   f->value.function.name =
     gfc_get_string (PREFIX("eoshift%d_%d"), n, shift->ts.kind);
@@ -921,7 +944,7 @@ gfc_resolve_maxloc (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
   else
     {
       f->rank = array->rank - 1;
-      gfc_resolve_index (dim, 1);
+      gfc_resolve_dim_arg (dim);
     }
 
   name = mask ? "mmaxloc" : "maxloc";
@@ -940,7 +963,7 @@ gfc_resolve_maxval (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
   if (dim != NULL)
     {
       f->rank = array->rank - 1;
-      gfc_resolve_index (dim, 1);
+      gfc_resolve_dim_arg (dim);
     }
 
   f->value.function.name =
@@ -982,7 +1005,7 @@ gfc_resolve_minloc (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
   else
     {
       f->rank = array->rank - 1;
-      gfc_resolve_index (dim, 1);
+      gfc_resolve_dim_arg (dim);
     }
 
   name = mask ? "mminloc" : "minloc";
@@ -1001,7 +1024,7 @@ gfc_resolve_minval (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
   if (dim != NULL)
     {
       f->rank = array->rank - 1;
-      gfc_resolve_index (dim, 1);
+      gfc_resolve_dim_arg (dim);
     }
 
   f->value.function.name =
@@ -1098,7 +1121,7 @@ gfc_resolve_product (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
   if (dim != NULL)
     {
       f->rank = array->rank - 1;
-      gfc_resolve_index (dim, 1);
+      gfc_resolve_dim_arg (dim);
     }
 
   f->value.function.name =
@@ -1341,7 +1364,7 @@ gfc_resolve_spread (gfc_expr * f, gfc_expr * source,
   f->rank = source->rank + 1;
   f->value.function.name = PREFIX("spread");
 
-  gfc_resolve_index (dim, 1);
+  gfc_resolve_dim_arg (dim);
   gfc_resolve_index (ncopies, 1);
 }
 
@@ -1388,7 +1411,7 @@ gfc_resolve_sum (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
   if (dim != NULL)
     {
       f->rank = array->rank - 1;
-      gfc_resolve_index (dim, 1);
+      gfc_resolve_dim_arg (dim);
     }
 
   f->value.function.name =

gcc/fortran/resolve.c

@@ -1828,6 +1828,40 @@ gfc_resolve_index (gfc_expr * index, int check_scalar)
   return SUCCESS;
 }
 
+/* Resolve a dim argument to an intrinsic function.  */
+
+try
+gfc_resolve_dim_arg (gfc_expr *dim)
+{
+  if (dim == NULL)
+    return SUCCESS;
+
+  if (gfc_resolve_expr (dim) == FAILURE)
+    return FAILURE;
+
+  if (dim->rank != 0)
+    {
+      gfc_error ("Argument dim at %L must be scalar", &dim->where);
+      return FAILURE;
+  
+    }
+  if (dim->ts.type != BT_INTEGER)
+    {
+      gfc_error ("Argument dim at %L must be of INTEGER type", &dim->where);
+      return FAILURE;
+    }
+  if (dim->ts.kind != gfc_index_integer_kind)
+    {
+      gfc_typespec ts;
+
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_index_integer_kind;
+
+      gfc_convert_type_warn (dim, &ts, 2, 0);
+    }
+
+  return SUCCESS;
+}
 
 /* Given an expression that contains array references, update those array
    references to point to the right array specifications.  While this is

gcc/testsuite/ChangeLog

+2005-08-10  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR libfortran/22143
+	gfortran.dg/shift-kind.f90:  New testcase.
+
 2005-08-10  Richard Sandiford  <richard@codesourcery.com>
 
 	* gcc.dg/arm-eabi1.c: Test aeabi_idiv, __aeabi_uidiv, __aeabi_uread4,

gcc/testsuite/gfortran.dg/shift-kind.f90

+! { dg-do compile }
+! PR 22143:  We didn' have shift arguments to eoshift of kind=1
+!            and kind=2.
+program main
+  implicit none
+  integer, dimension (3,3) :: a, b, w
+  integer(kind=2), dimension (3) :: sh2
+  integer(kind=1), dimension (3) :: sh1
+  integer, dimension(3) :: bo
+  integer :: i,j
+
+  a = reshape((/(i,i=1,9)/),shape(a))
+  sh1 = (/ -3, -1, 3 /)
+  sh2 = (/ -3, -1, 3 /)
+  bo = (/-999, -99, -9 /)
+  b = cshift(a, shift=sh1)
+  call foo(b)
+  b = cshift(a, shift=sh2)
+  call foo(b)
+
+  b = eoshift(a, shift=sh1)
+  call foo(b)
+  b = eoshift(a, shift=sh1, boundary=bo)
+  call foo(b)
+  b = eoshift(a, shift=sh2)
+  call foo(b)
+  b = eoshift(a, shift=sh2, boundary=bo)
+  call foo(b)
+
+end program main
+
+subroutine foo(b)
+  ! Do nothing but confuse the optimizer into not removing the
+  ! function calls.
+  integer, dimension(3,3) :: b
+end subroutine foo
+