Skip to content

R
riscv-gcc-1
Commit bf302220 by Thomas Koenig Committed by Thomas Koenig
Options

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
parent bb8df8a6
Showing with 134 additions and 15 deletions
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 0 → 100644
! { 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment