This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch, fortran] PR19015 - shape / rank mismatch in maxloc / minloc could be caught at compile time
- From: Paul Thomas <paulthomas2 at wanadoo dot fr>
- To: "'fortran at gcc dot gnu dot org'" <fortran at gcc dot gnu dot org>, patch <gcc-patches at gcc dot gnu dot org>
- Date: Mon, 15 May 2006 22:32:03 +0200
- Subject: [Patch, fortran] PR19015 - shape / rank mismatch in maxloc / minloc could be caught at compile time
:ADDPATCH fortran:
Thomas has already fixed this bug at runtime and changed the PR to
reflect the possibility of doing compile time checks. This patch does
just that for maxloc/minloc/maxvar/minvar.
The patch operates differently for maxloc and minloc, when the argument
DIM is not present; in this case, the ARRAY rank is converted and passed
as the shape parameter. Otherwise, when DIM is present for all four
functions, the shape of ARRAY is passed, less the shape for the
dimension DIM. The testcase is Thomas' original from the PR.
Regtested on FC5/Athlon1700. OK for trunks and, a week later, for 4.1?
Paul
2006-05-15 Paul Thomas <pault@gcc.gnu.org>
PR fortran/19015
* iresolve.c (maxloc, minloc): If DIM is not present, pass the
rank of ARRAY as the shape of the result. Otherwise, pass the
shape of ARRAY, less the dimension DIM.
(maxval, minval): The same, when DIM is present, otherwise no
change.
2006-05-15 Paul Thomas <pault@gcc.gnu.org>
PR fortran/19015
* gfortran.dg/maxloc_shape_1.f90: New test.
Index: gcc/fortran/iresolve.c
===================================================================
--- gcc/fortran/iresolve.c (revision 113735)
+++ gcc/fortran/iresolve.c (working copy)
@@ -1081,16 +1081,32 @@
gfc_expr * mask)
{
const char *name;
+ int i, j, idim;
f->ts.type = BT_INTEGER;
f->ts.kind = gfc_default_integer_kind;
if (dim == NULL)
- f->rank = 1;
+ {
+ f->rank = 1;
+ f->shape = gfc_get_shape (1);
+ mpz_init_set_si (f->shape[0], array->rank);
+ }
else
{
f->rank = array->rank - 1;
gfc_resolve_dim_arg (dim);
+ if (array->shape && dim->expr_type == EXPR_CONSTANT)
+ {
+ idim = (int) mpz_get_si (dim->value.integer);
+ f->shape = gfc_get_shape (f->rank);
+ for (i = 0, j = 0; i < f->rank; i++, j++)
+ {
+ if (i == (idim - 1))
+ j++;
+ mpz_init_set (f->shape[i], array->shape[j]);
+ }
+ }
}
if (mask)
@@ -1125,6 +1141,7 @@
gfc_expr * mask)
{
const char *name;
+ int i, j, idim;
f->ts = array->ts;
@@ -1132,6 +1149,18 @@
{
f->rank = array->rank - 1;
gfc_resolve_dim_arg (dim);
+
+ if (f->rank && array->shape && dim->expr_type == EXPR_CONSTANT)
+ {
+ idim = (int) mpz_get_si (dim->value.integer);
+ f->shape = gfc_get_shape (f->rank);
+ for (i = 0, j = 0; i < f->rank; i++, j++)
+ {
+ if (i == (idim - 1))
+ j++;
+ mpz_init_set (f->shape[i], array->shape[j]);
+ }
+ }
}
if (mask)
@@ -1188,16 +1217,32 @@
gfc_expr * mask)
{
const char *name;
+ int i, j, idim;
f->ts.type = BT_INTEGER;
f->ts.kind = gfc_default_integer_kind;
if (dim == NULL)
- f->rank = 1;
+ {
+ f->rank = 1;
+ f->shape = gfc_get_shape (1);
+ mpz_init_set_si (f->shape[0], array->rank);
+ }
else
{
f->rank = array->rank - 1;
gfc_resolve_dim_arg (dim);
+ if (array->shape && dim->expr_type == EXPR_CONSTANT)
+ {
+ idim = (int) mpz_get_si (dim->value.integer);
+ f->shape = gfc_get_shape (f->rank);
+ for (i = 0, j = 0; i < f->rank; i++, j++)
+ {
+ if (i == (idim - 1))
+ j++;
+ mpz_init_set (f->shape[i], array->shape[j]);
+ }
+ }
}
if (mask)
@@ -1232,6 +1277,7 @@
gfc_expr * mask)
{
const char *name;
+ int i, j, idim;
f->ts = array->ts;
@@ -1239,6 +1285,18 @@
{
f->rank = array->rank - 1;
gfc_resolve_dim_arg (dim);
+
+ if (f->rank && array->shape && dim->expr_type == EXPR_CONSTANT)
+ {
+ idim = (int) mpz_get_si (dim->value.integer);
+ f->shape = gfc_get_shape (f->rank);
+ for (i = 0, j = 0; i < f->rank; i++, j++)
+ {
+ if (i == (idim - 1))
+ j++;
+ mpz_init_set (f->shape[i], array->shape[j]);
+ }
+ }
}
if (mask)
Index: gcc/testsuite/gfortran.dg/maxloc_shape_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/maxloc_shape_1.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/maxloc_shape_1.f90 (revision 0)
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! Tests the implementation of compile-time shape testing, required to fix
+! PR19015. The functionality of maxloc and friends is tested by existing
+! testcases.
+!
+! Contributed by Thomas Koeing <Thomas.Koenig@online.de>
+!
+ integer, dimension(0:1,0:1) :: n
+ integer, dimension(1) :: i
+ n = reshape((/1, 2, 3, 4/), shape(n))
+ i = maxloc(n) ! { dg-error "different shape for Array assignment" }
+ print *,i
+end program
2006-05-15 Paul Thomas <pault@gcc.gnu.org>
PR fortran/19015
* iresolve.c (maxloc, minloc): If DIM is not present, pass the
rank of ARRAY as the shape of the result. Otherwise, pass the
shape of ARRAY, less the dimension DIM.
(maxval, minval): The same, when DIM is present, otherwise no
change.
2006-05-15 Paul Thomas <pault@gcc.gnu.org>
PR fortran/19015
* gfortran.dg/maxloc_shape_1.f90: New test.