+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
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);
}
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);
}
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);
}
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);
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);
else
{
f->rank = array->rank - 1;
- gfc_resolve_index (dim, 1);
+ gfc_resolve_dim_arg (dim);
}
name = mask ? "mmaxloc" : "maxloc";
if (dim != NULL)
{
f->rank = array->rank - 1;
- gfc_resolve_index (dim, 1);
+ gfc_resolve_dim_arg (dim);
}
f->value.function.name =
else
{
f->rank = array->rank - 1;
- gfc_resolve_index (dim, 1);
+ gfc_resolve_dim_arg (dim);
}
name = mask ? "mminloc" : "minloc";
if (dim != NULL)
{
f->rank = array->rank - 1;
- gfc_resolve_index (dim, 1);
+ gfc_resolve_dim_arg (dim);
}
f->value.function.name =
if (dim != NULL)
{
f->rank = array->rank - 1;
- gfc_resolve_index (dim, 1);
+ gfc_resolve_dim_arg (dim);
}
f->value.function.name =
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);
}
if (dim != NULL)
{
f->rank = array->rank - 1;
- gfc_resolve_index (dim, 1);
+ gfc_resolve_dim_arg (dim);
}
f->value.function.name =
--- /dev/null
+! { 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
+