Skip to content

R
riscv-gcc-1
Commit ac5ba373 by Tobias Schlüter
Options

re PR fortran/25076 (FORALL triplet subscript must not reference any index-name) 

PR fortran/25076
fortran/
* resolve.c (gfc_find_forall_index): Move towards top,
renaming to ...
(find_forall_index): ... this.  Add check for NULL expr.
(resolve_forall_iterators): Verify additional constraint.
(resolve_forall): Remove checks obsoleted by new code in
resolve_forall_iterators.
testsuite/
* gfortran.dg/forall_11.f90: New.

From-SVN: r129050
parent 6116ca65
Showing with 199 additions and 143 deletions
gcc/fortran/ChangeLog
2007-10-06 Tobias Schlter <tobi@gcc.gnu.org>
PR fortran/25076
* resolve.c (gfc_find_forall_index): Move towards top,
renaming to ...
(find_forall_index): ... this. Add check for NULL expr.
(resolve_forall_iterators): Verify additional constraint.
(resolve_forall): Remove checks obsoleted by new code in
resolve_forall_iterators.
2007-10-05 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
* gfortran.h (gfc_get_data_variable, gfc_get_data_value,
......
gcc/fortran/resolve.c
......@@ -4296,14 +4296,147 @@ gfc_resolve_iterator (gfc_iterator *iter, bool real_ok)
}
/* 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))
......@@ -4337,9 +4470,21 @@ resolve_forall_iterators (gfc_forall_iterator *iter)
}
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);
}
}
......@@ -5529,130 +5674,6 @@ resolve_where (gfc_code *code, gfc_expr *mask)
}
/* 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. */
......@@ -5679,7 +5700,7 @@ gfc_resolve_assign_in_forall (gfc_code *code, int nvar, gfc_expr **var_expr)
/* 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);
......@@ -5785,7 +5806,6 @@ gfc_resolve_forall (gfc_code *code, gfc_namespace *ns, int forall_save)
static int total_var = 0;
static int nvar = 0;
gfc_forall_iterator *fa;
gfc_symbol *forall_index;
gfc_code *next;
int i;
......@@ -5824,18 +5844,6 @@ gfc_resolve_forall (gfc_code *code, gfc_namespace *ns, int forall_save)
/* 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++;
}
......
gcc/testsuite/ChangeLog
2007-10-06 Tobias Schlter <tobi@gcc.gnu.org>
PR fortran/25076
* gfortran.dg/forall_11.f90: New.
2007-10-05 Michael Matz <matz@suse.de>
PR middle-end/33667
gcc/testsuite/gfortran.dg/forall_11.f90 0 → 100644
! { 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=i:10) ! { dg-error "FORALL index 'i' may not appear in triplet specification" }
forall (j=1:j:i) ! { dg-error "FORALL index 'j' may not appear in triplet specification" }
a(i,j) = i*j
end forall
end forall
forall (i=1:10:i) ! { dg-error "FORALL index 'i' may not appear in triplet specification" }
a(1,i) = 2
end forall
forall (i=1:10)
forall (j=i:10)
a(i,j) = i*j
end forall
end forall
END
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