------- Comment #1 from paul dot richard dot thomas at cea dot fr 2006-05-11
10:22 -------
The following patch fixes this bug. It makes use of existing calls to
gfc_resolve_expr, whilst resolving specification expressions, to check that
variables used are parameters of each and every entry. Since existing code is
recycled and the test in gfc_resolve_epr is pretty exclusive, the load on
resolution is negligible.
I will submit asap.
Paul
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (révision 113111)
+++ gcc/fortran/resolve.c (copie de travail)
@@ -60,6 +60,9 @@
resets the flag each time that it is read. */
static int formal_arg_flag = 0;
+/* True if we are resolving a specification expression. */
+static int resolving_index_expr = 0;
+
int
gfc_is_formal_arg (void)
{
@@ -2623,6 +2639,50 @@
}
+/* Emits an error if the expression is a variable that is
+ not a parameter in all entry formal argument lists for
+ the namespace. */
+
+static void
+entry_parameter (gfc_expr *e)
+{
+ gfc_symbol *sym, *esym;
+ gfc_entry_list *entry;
+ gfc_formal_arglist *f;
+ bool p;
+
+ if (e->expr_type != EXPR_VARIABLE)
+ return;
+
+ sym = e->symtree->n.sym;
+ if (sym->ns->entries
+ && !sym->attr.use_assoc
+ && sym->attr.dummy
+ && sym->ns == gfc_current_ns)
+ {
+ entry = sym->ns->entries;
+ for (; entry; entry = entry->next)
+ {
+ esym = entry->sym;
+ p = false;
+ f = esym->formal;
+ for (; f && !p; f = f->next)
+ {
+ if (f->sym && f->sym->name
+ && sym->name == f->sym->name)
+ {
+ p = true;
+ }
+ }
+ if (!p)
+ gfc_error ("%s at %L must be a parameter of the entry at %L",
+ sym->name, &e->where, &esym->declared_at);
+ }
+ }
+ return;
+}
+
+
/* Resolve an expression. That is, make sure that types of operands agree
with their operators, intrinsic operators are converted to function calls
for overloaded types and unresolved function references are resolved. */
@@ -2647,6 +2707,10 @@
case EXPR_VARIABLE:
t = resolve_variable (e);
+
+ if (gfc_current_ns->entries && resolving_index_expr)
+ entry_parameter (e);
+
if (t == SUCCESS)
expression_rank (e);
break;
@@ -4597,7 +4661,6 @@
static try
resolve_index_expr (gfc_expr * e)
{
-
if (gfc_resolve_expr (e) == FAILURE)
return FAILURE;
@@ -4620,9 +4683,12 @@
cl->resolved = 1;
+ resolving_index_expr = 1;
+
if (resolve_index_expr (cl->length) == FAILURE)
return FAILURE;
+ resolving_index_expr = 0;
return SUCCESS;
}
@@ -4709,20 +4775,29 @@
if (resolve_fl_var_and_proc (sym, mp_flag) == FAILURE)
return FAILURE;
- /* The shape of a main program or module array needs to be constant. */
- if (sym->ns->proc_name
- && (sym->ns->proc_name->attr.flavor == FL_MODULE
- || sym->ns->proc_name->attr.is_main_program)
- && !sym->attr.use_assoc
+ /* Set this flag to check that variables are parameters of all entries.
+ This check is effected by the call to gfc_resolve_expr through
+ is_non_contant_shape_array. */
+ resolving_index_expr = 1;
+
+ if (!sym->attr.use_assoc
&& !sym->attr.allocatable
&& !sym->attr.pointer
&& is_non_constant_shape_array (sym))
{
- gfc_error ("The module or main program array '%s' at %L must "
- "have constant shape", sym->name, &sym->declared_at);
- return FAILURE;
+ /* The shape of a main program or module array needs to be constant.
*/
+ if (sym->ns->proc_name
+ && (sym->ns->proc_name->attr.flavor == FL_MODULE
+ || sym->ns->proc_name->attr.is_main_program))
+ {
+ gfc_error ("The module or main program array '%s' at %L must "
+ "have constant shape", sym->name, &sym->declared_at);
+ return FAILURE;
+ }
}
+ resolving_index_expr = 0;
+
if (sym->ts.type == BT_CHARACTER)
{
/* Make sure that character string variables with assumed length are
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=25090
