This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[gfortran, fix PR 25097] Additional constraints on FORALL headers
- From: Tobias Schlüter <tobias dot schlueter at physik dot uni-muenchen dot de>
- To: Fortran List <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Thu, 04 Oct 2007 21:56:59 +0200
- Subject: [gfortran, fix PR 25097] Additional constraints on FORALL headers
Hi,
we hadn't yet implemented the following constraint on FORALL headers:
"A subscript or stride in a forall-triplet-spec shall not contain a
reference to any index-name in the forall-triplet-spec-list in which it
appears." This patch fixes this, using the pre-existing
gfc_find_forall_index for the purpose. This meant moving it to the
front of the file, and calling it in a trivial fashion (which is
wasteful, but I can't imagine this ever becoming a performance
bottleneck). I promise to remove the "gfc_" prefix, I only realized its
presence after I had cut the diff.
Built and tested on i386-darwin.
Cheers,
- Tobi
2007-10-04 Tobias Schlüter <tobi@gcc.gnu.org>
PR fortran/25097
fortran/
* resolve.c (gfc_find_forall_index): Move towards top.
(resolve_forall_iterators): Verify additional constraint.
testsuite/
* gfortran.dg/forall_11.f90: New.
diff -r 837a74b49f29 gcc/fortran/resolve.c
--- a/gcc/fortran/resolve.c Thu Oct 04 15:59:54 2007 +0000
+++ b/gcc/fortran/resolve.c Thu Oct 04 21:43:54 2007 +0200
@@ -4295,14 +4295,144 @@ gfc_resolve_iterator (gfc_iterator *iter
}
+/* Check whether the FORALL index appears in the expression or not.
+ Returns SUCCESS if SYM is found in EXPR. */
+
+static try
+gfc_find_forall_index (gfc_expr *expr, gfc_symbol *symbol)
+{
+ gfc_array_ref ar;
+ gfc_ref *tmp;
+ gfc_actual_arglist *args;
+ int i;
+
+ switch (expr->expr_type)
+ {
+ case EXPR_VARIABLE:
+ gcc_assert (expr->symtree->n.sym);
+
+ /* A scalar assignment */
+ if (!expr->ref)
+ {
+ if (expr->symtree->n.sym == symbol)
+ return SUCCESS;
+ else
+ return FAILURE;
+ }
+
+ /* the expr is array ref, substring or struct component. */
+ tmp = expr->ref;
+ while (tmp != NULL)
+ {
+ switch (tmp->type)
+ {
+ case REF_ARRAY:
+ /* Check if the symbol appears in the array subscript. */
+ ar = tmp->u.ar;
+ for (i = 0; i < GFC_MAX_DIMENSIONS; i++)
+ {
+ if (ar.start[i])
+ if (gfc_find_forall_index (ar.start[i], symbol) == SUCCESS)
+ return SUCCESS;
+
+ if (ar.end[i])
+ if (gfc_find_forall_index (ar.end[i], symbol) == SUCCESS)
+ return SUCCESS;
+
+ if (ar.stride[i])
+ if (gfc_find_forall_index (ar.stride[i], symbol) == SUCCESS)
+ return SUCCESS;
+ } /* end for */
+ break;
+
+ case REF_SUBSTRING:
+ if (expr->symtree->n.sym == symbol)
+ return SUCCESS;
+ tmp = expr->ref;
+ /* Check if the symbol appears in the substring section. */
+ if (gfc_find_forall_index (tmp->u.ss.start, symbol) == SUCCESS)
+ return SUCCESS;
+ if (gfc_find_forall_index (tmp->u.ss.end, symbol) == SUCCESS)
+ return SUCCESS;
+ break;
+
+ case REF_COMPONENT:
+ break;
+
+ default:
+ gfc_error("expression reference type error at %L", &expr->where);
+ }
+ tmp = tmp->next;
+ }
+ break;
+
+ /* If the expression is a function call, then check if the symbol
+ appears in the actual arglist of the function. */
+ case EXPR_FUNCTION:
+ for (args = expr->value.function.actual; args; args = args->next)
+ {
+ if (gfc_find_forall_index(args->expr,symbol) == SUCCESS)
+ return SUCCESS;
+ }
+ break;
+
+ /* It seems not to happen. */
+ case EXPR_SUBSTRING:
+ if (expr->ref)
+ {
+ tmp = expr->ref;
+ gcc_assert (expr->ref->type == REF_SUBSTRING);
+ if (gfc_find_forall_index (tmp->u.ss.start, symbol) == SUCCESS)
+ return SUCCESS;
+ if (gfc_find_forall_index (tmp->u.ss.end, symbol) == SUCCESS)
+ return SUCCESS;
+ }
+ break;
+
+ /* It seems not to happen. */
+ case EXPR_STRUCTURE:
+ case EXPR_ARRAY:
+ gfc_error ("Unsupported statement while finding forall index in "
+ "expression");
+ break;
+
+ case EXPR_OP:
+ /* Find the FORALL index in the first operand. */
+ if (expr->value.op.op1)
+ {
+ if (gfc_find_forall_index (expr->value.op.op1, symbol) == SUCCESS)
+ return SUCCESS;
+ }
+
+ /* Find the FORALL index in the second operand. */
+ if (expr->value.op.op2)
+ {
+ if (gfc_find_forall_index (expr->value.op.op2, symbol) == SUCCESS)
+ return SUCCESS;
+ }
+ break;
+
+ default:
+ break;
+ }
+
+ return FAILURE;
+}
+
+
/* Resolve a list of FORALL iterators. The FORALL index-name is constrained
to be a scalar INTEGER variable. The subscripts and stride are scalar
- INTEGERs, and if stride is a constant it must be nonzero. */
+ INTEGERs, and if stride is a constant it must be nonzero.
+ Furthermore "A subscript or stride in a forall-triplet-spec shall
+ not contain a reference to any index-name in the
+ forall-triplet-spec-list in which it appears." (7.5.4.1) */
static void
-resolve_forall_iterators (gfc_forall_iterator *iter)
-{
- while (iter)
+resolve_forall_iterators (gfc_forall_iterator *it)
+{
+ gfc_forall_iterator *iter, *iter2;
+
+ for (iter = it; iter; iter = iter->next)
{
if (gfc_resolve_expr (iter->var) == SUCCESS
&& (iter->var->ts.type != BT_INTEGER || iter->var->rank != 0))
@@ -4336,9 +4466,21 @@ resolve_forall_iterators (gfc_forall_ite
}
if (iter->var->ts.kind != iter->stride->ts.kind)
gfc_convert_type (iter->stride, &iter->var->ts, 2);
-
- iter = iter->next;
- }
+ }
+
+ for (iter = it; iter; iter = iter->next)
+ for (iter2 = iter->next; iter2; iter2 = iter2->next)
+ {
+ if (gfc_find_forall_index (iter2->start,
+ iter->var->symtree->n.sym) == SUCCESS
+ || gfc_find_forall_index (iter2->end,
+ iter->var->symtree->n.sym) == SUCCESS
+ || gfc_find_forall_index (iter2->stride,
+ iter->var->symtree->n.sym) == SUCCESS)
+ gfc_error ("FORALL index '%s' may not appear in triplet "
+ "specification at %L", iter->var->symtree->name,
+ &iter->start->where);
+ }
}
@@ -5528,130 +5670,6 @@ resolve_where (gfc_code *code, gfc_expr
}
-/* Check whether the FORALL index appears in the expression or not. */
-
-static try
-gfc_find_forall_index (gfc_expr *expr, gfc_symbol *symbol)
-{
- gfc_array_ref ar;
- gfc_ref *tmp;
- gfc_actual_arglist *args;
- int i;
-
- switch (expr->expr_type)
- {
- case EXPR_VARIABLE:
- gcc_assert (expr->symtree->n.sym);
-
- /* A scalar assignment */
- if (!expr->ref)
- {
- if (expr->symtree->n.sym == symbol)
- return SUCCESS;
- else
- return FAILURE;
- }
-
- /* the expr is array ref, substring or struct component. */
- tmp = expr->ref;
- while (tmp != NULL)
- {
- switch (tmp->type)
- {
- case REF_ARRAY:
- /* Check if the symbol appears in the array subscript. */
- ar = tmp->u.ar;
- for (i = 0; i < GFC_MAX_DIMENSIONS; i++)
- {
- if (ar.start[i])
- if (gfc_find_forall_index (ar.start[i], symbol) == SUCCESS)
- return SUCCESS;
-
- if (ar.end[i])
- if (gfc_find_forall_index (ar.end[i], symbol) == SUCCESS)
- return SUCCESS;
-
- if (ar.stride[i])
- if (gfc_find_forall_index (ar.stride[i], symbol) == SUCCESS)
- return SUCCESS;
- } /* end for */
- break;
-
- case REF_SUBSTRING:
- if (expr->symtree->n.sym == symbol)
- return SUCCESS;
- tmp = expr->ref;
- /* Check if the symbol appears in the substring section. */
- if (gfc_find_forall_index (tmp->u.ss.start, symbol) == SUCCESS)
- return SUCCESS;
- if (gfc_find_forall_index (tmp->u.ss.end, symbol) == SUCCESS)
- return SUCCESS;
- break;
-
- case REF_COMPONENT:
- break;
-
- default:
- gfc_error("expression reference type error at %L", &expr->where);
- }
- tmp = tmp->next;
- }
- break;
-
- /* If the expression is a function call, then check if the symbol
- appears in the actual arglist of the function. */
- case EXPR_FUNCTION:
- for (args = expr->value.function.actual; args; args = args->next)
- {
- if (gfc_find_forall_index(args->expr,symbol) == SUCCESS)
- return SUCCESS;
- }
- break;
-
- /* It seems not to happen. */
- case EXPR_SUBSTRING:
- if (expr->ref)
- {
- tmp = expr->ref;
- gcc_assert (expr->ref->type == REF_SUBSTRING);
- if (gfc_find_forall_index (tmp->u.ss.start, symbol) == SUCCESS)
- return SUCCESS;
- if (gfc_find_forall_index (tmp->u.ss.end, symbol) == SUCCESS)
- return SUCCESS;
- }
- break;
-
- /* It seems not to happen. */
- case EXPR_STRUCTURE:
- case EXPR_ARRAY:
- gfc_error ("Unsupported statement while finding forall index in "
- "expression");
- break;
-
- case EXPR_OP:
- /* Find the FORALL index in the first operand. */
- if (expr->value.op.op1)
- {
- if (gfc_find_forall_index (expr->value.op.op1, symbol) == SUCCESS)
- return SUCCESS;
- }
-
- /* Find the FORALL index in the second operand. */
- if (expr->value.op.op2)
- {
- if (gfc_find_forall_index (expr->value.op.op2, symbol) == SUCCESS)
- return SUCCESS;
- }
- break;
-
- default:
- break;
- }
-
- return FAILURE;
-}
-
-
/* Resolve assignment in FORALL construct.
NVAR is the number of FORALL index variables, and VAR_EXPR records the
FORALL index variables. */
diff -r 837a74b49f29 gcc/testsuite/gfortran.dg/forall_11.f90
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/gfortran.dg/forall_11.f90 Thu Oct 04 21:43:54 2007 +0200
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! PR 25076
+! We erroneously accepted it when a FORALL index was used in a triplet
+! specification within the same FORALL header
+INTEGER :: A(10,10)
+FORALL(I=1:10,J=I:10) ! { dg-error "FORALL index 'i' may not appear in triplet specification" }
+ A(I,J)=I+J
+ENDFORALL
+
+forall (i=1:10, j=1:i) ! { dg-error "FORALL index 'i' may not appear in triplet specification" }
+ a(i,j) = 5
+end forall
+
+forall (i=1:10, j=1:10:i) ! { dg-error "FORALL index 'i' may not appear in triplet specification" }
+ a(i,j) = i - j
+end forall
+
+forall (i=1:10)
+ forall (j=i:10)
+ a(i,j) = i*j
+ end forall
+end forall
+END