}
+/* Check whether the FORALL index appears in the expression or not.
+ Returns SUCCESS if SYM is found in EXPR. */
+
+static try
+find_forall_index (gfc_expr *expr, gfc_symbol *symbol)
+{
+ gfc_array_ref ar;
+ gfc_ref *tmp;
+ gfc_actual_arglist *args;
+ int i;
+
+ if (!expr)
+ return FAILURE;
+
+ 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 (find_forall_index (ar.start[i], symbol) == SUCCESS)
+ return SUCCESS;
+
+ if (ar.end[i])
+ if (find_forall_index (ar.end[i], symbol) == SUCCESS)
+ return SUCCESS;
+
+ if (ar.stride[i])
+ if (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 (find_forall_index (tmp->u.ss.start, symbol) == SUCCESS)
+ return SUCCESS;
+ if (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 (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 (find_forall_index (tmp->u.ss.start, symbol) == SUCCESS)
+ return SUCCESS;
+ if (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 (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 (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)
+resolve_forall_iterators (gfc_forall_iterator *it)
{
- while (iter)
+ 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))
}
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; iter2; iter2 = iter2->next)
+ {
+ if (find_forall_index (iter2->start,
+ iter->var->symtree->n.sym) == SUCCESS
+ || find_forall_index (iter2->end,
+ iter->var->symtree->n.sym) == SUCCESS
+ || 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,
+ &iter2->start->where);
+ }
}
}
-/* 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. */
/* If one of the FORALL index variables doesn't appear in the
assignment target, then there will be a many-to-one
assignment. */
- if (gfc_find_forall_index (code->expr, forall_index) == FAILURE)
+ if (find_forall_index (code->expr, forall_index) == FAILURE)
gfc_error ("The FORALL with index '%s' cause more than one "
"assignment to this object at %L",
var_expr[n]->symtree->name, &code->expr->where);
static int total_var = 0;
static int nvar = 0;
gfc_forall_iterator *fa;
- gfc_symbol *forall_index;
gfc_code *next;
int i;
/* Record the current FORALL index. */
var_expr[nvar] = gfc_copy_expr (fa->var);
- forall_index = fa->var->symtree->n.sym;
-
- /* Check if the FORALL index appears in start, end or stride. */
- if (gfc_find_forall_index (fa->start, forall_index) == SUCCESS)
- gfc_error ("A FORALL index must not appear in a limit or stride "
- "expression in the same FORALL at %L", &fa->start->where);
- if (gfc_find_forall_index (fa->end, forall_index) == SUCCESS)
- gfc_error ("A FORALL index must not appear in a limit or stride "
- "expression in the same FORALL at %L", &fa->end->where);
- if (gfc_find_forall_index (fa->stride, forall_index) == SUCCESS)
- gfc_error ("A FORALL index must not appear in a limit or stride "
- "expression in the same FORALL at %L", &fa->stride->where);
nvar++;
}