From bf30222095f87487f17327279fe563dff47479df Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Wed, 10 Aug 2005 20:16:29 +0000 Subject: [PATCH] re PR libfortran/22143 (missing kinds 1 and 2 for eoshift and cshift) 2005-08-10 Thomas Koenig 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 PR libfortran/22143 gfortran.dg/shift-kind.f90: New testcase. From-SVN: r102957 --- gcc/fortran/ChangeLog | 19 ++++++++++++ gcc/fortran/gfortran.h | 1 + gcc/fortran/iresolve.c | 53 +++++++++++++++++++++++--------- gcc/fortran/resolve.c | 34 ++++++++++++++++++++ gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/shift-kind.f90 | 37 ++++++++++++++++++++++ 6 files changed, 134 insertions(+), 15 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/shift-kind.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e19247f..bbbda8d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,22 @@ +2005-08-10 Thomas Koenig + + 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 * check.c (gfc_check_ttynam_sub, gfc_check_isatty): Add check diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index ac27105..cb68ad4 100644 --- a/gcc/fortran/gfortran.h +++ b/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 *); diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index a6f7f27..ef43946 100644 --- a/gcc/fortran/iresolve.c +++ b/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 = diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index d855a7f..ace5958 100644 --- a/gcc/fortran/resolve.c +++ b/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 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index effde2e..7d4d8f2 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2005-08-10 Thomas Koenig + + PR libfortran/22143 + gfortran.dg/shift-kind.f90: New testcase. + 2005-08-10 Richard Sandiford * gcc.dg/arm-eabi1.c: Test aeabi_idiv, __aeabi_uidiv, __aeabi_uread4, diff --git a/gcc/testsuite/gfortran.dg/shift-kind.f90 b/gcc/testsuite/gfortran.dg/shift-kind.f90 new file mode 100644 index 0000000..70d87481 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/shift-kind.f90 @@ -0,0 +1,37 @@ +! { 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 + -- 2.7.4