===================================================================
@@ -39,6 +39,7 @@ static bool optimize_trim (gfc_expr *);
static bool optimize_lexical_comparison (gfc_expr *);
static void optimize_minmaxloc (gfc_expr **);
static bool empty_string (gfc_expr *e);
+static void do_warn (gfc_namespace *);
/* How deep we are inside an argument list. */
@@ -76,12 +77,29 @@ static bool in_omp_workshare;
static int iterator_level;
-/* Entry point - run all passes for a namespace. So far, only an
- optimization pass is run. */
+/* Keep track of DO loop levels. */
+static gfc_code **do_list;
+static int do_size, do_level;
+
+/* Vector of gfc_expr * to keep track of DO loops. */
+
+struct my_struct *evec;
+
+/* Entry point - run all passes for a namespace. */
+
void
gfc_run_passes (gfc_namespace *ns)
{
+
+ /* Warn about dubious DO loops where the index might
+ change. */
+
+ do_size = 20;
+ do_list = XNEWVEC(gfc_code *, do_size);
+ do_warn (ns);
+ XDELETEVEC (do_list);
+
if (gfc_option.flag_frontend_optimize)
{
expr_size = 20;
@@ -605,6 +623,7 @@ optimize_namespace (gfc_namespace *ns)
current_ns = ns;
forall_level = 0;
iterator_level = 0;
+ do_level = 0;
in_omp_workshare = false;
gfc_code_walker (&ns->code, convert_do_while, dummy_expr_callback, NULL);
@@ -1225,6 +1244,157 @@ optimize_minmaxloc (gfc_expr **e)
mpz_set_ui (a->expr->value.integer, 1);
}
+static int
+do_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
+ void *data ATTRIBUTE_UNUSED)
+{
+ gfc_code *co;
+ int i;
+ gfc_formal_arglist *f;
+ gfc_actual_arglist *a;
+
+ co = *c;
+
+ switch (co->op)
+ {
+ case EXEC_DO:
+ if (do_level >= do_size)
+ {
+ do_size = 2 * do_size;
+ do_list = XRESIZEVEC (gfc_code *, do_list, do_size);
+ }
+
+ if (co->ext.iterator && co->ext.iterator->var)
+ do_list[do_level] = co;
+ else
+ do_list[do_level] = NULL;
+ break;
+
+ case EXEC_CALL:
+ a = co->ext.actual;
+ f = co->symtree->n.sym->formal;
+
+ while (a)
+ {
+ for (i=0; i<do_level; i++)
+ {
+ if (do_list[i] == NULL)
+ break;
+
+ gfc_symbol *do_sym = do_list[i]->ext.iterator->var->symtree->n.sym;
+
+ if (a->expr && a->expr->symtree
+ && a->expr->symtree->n.sym == do_sym)
+ {
+ if (f)
+ {
+ if (f->sym->attr.intent == INTENT_OUT)
+ gfc_error_now("Variable '%s' at %L redefined inside loop "
+ "beginning at %L as INTENT(OUT) argument to "
+ "subroutine '%s'", do_sym->name, &a->expr->where,
+ &do_list[i]->loc, co->symtree->n.sym->name);
+ else if (f->sym->attr.intent == INTENT_INOUT)
+ gfc_warning_now("Variable '%s' at %L may redefined inside loop "
+ "beginning at %L as INTENT(INOUT) argument to "
+ "subroutine '%s'", do_sym->name, &a->expr->where,
+ &do_list[i]->loc, co->symtree->n.sym->name);
+ else if (f->sym->attr.intent == INTENT_UNKNOWN)
+ gfc_warning_now("Variable '%s' at %L may redefined inside loop "
+ "beginning at %L as argument to "
+ "subroutine '%s'", do_sym->name, &a->expr->where,
+ &do_list[i]->loc, co->symtree->n.sym->name);
+ }
+ else
+ gfc_warning_now("Variable '%s' at %L may redefined inside loop "
+ "beginning at %L as argument to "
+ "subroutine '%s'", do_sym->name, &a->expr->where,
+ &do_list[i]->loc, co->symtree->n.sym->name);
+ }
+ }
+ a = a->next;
+ if (f)
+ f = f->next;
+ }
+ break;
+
+ default:
+ break;
+ }
+ return 0;
+}
+
+static int
+do_function (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
+ void *data ATTRIBUTE_UNUSED)
+{
+ gfc_formal_arglist *f;
+ gfc_actual_arglist *a;
+ gfc_expr *expr;
+ int i;
+
+ expr = *e;
+ if (expr->expr_type != EXPR_FUNCTION)
+ return 0;
+
+ /* Intrinsic functions don't modify their arguments. */
+
+ if (expr->value.function.isym)
+ return 0;
+
+ a = expr->value.function.actual;
+ f = expr->symtree->n.sym->formal;
+
+ while (a)
+ {
+ for (i=0; i<do_level; i++)
+ {
+ if (do_list[i] == NULL)
+ break;
+
+ gfc_symbol *do_sym = do_list[i]->ext.iterator->var->symtree->n.sym;
+
+ if (a->expr && a->expr->symtree
+ && a->expr->symtree->n.sym == do_sym)
+ {
+ if (f)
+ {
+ if (f->sym->attr.intent == INTENT_OUT)
+ gfc_error_now("Variable '%s' at %L redefined inside loop "
+ "beginning at %L as INTENT(OUT) argument to "
+ "function '%s'", do_sym->name, &a->expr->where,
+ &do_list[i]->loc, expr->symtree->n.sym->name);
+ else if (f->sym->attr.intent == INTENT_INOUT)
+ gfc_warning_now("Variable '%s' at %L may redefined inside loop "
+ "beginning at %L as INTENT(INOUT) argument to "
+ "function '%s'", do_sym->name, &a->expr->where,
+ &do_list[i]->loc, expr->symtree->n.sym->name);
+ else if (f->sym->attr.intent == INTENT_UNKNOWN)
+ gfc_warning_now("Variable '%s' at %L may redefined inside loop "
+ "beginning at %L as argument to "
+ "function '%s'", do_sym->name, &a->expr->where,
+ &do_list[i]->loc, expr->symtree->n.sym->name);
+ }
+ else
+ gfc_warning_now("Variable '%s' at %L may redefined inside loop "
+ "beginning at %L as argument to "
+ "function '%s'", do_sym->name,
+ &expr->where, &do_list[i]->loc, expr->symtree->n.sym->name);
+ }
+ }
+ a = a->next;
+ if (f)
+ f = f->next;
+ }
+ return 0;
+}
+
+static void
+do_warn (gfc_namespace *ns)
+{
+ gfc_code_walker (&ns->code, do_code, do_function, NULL);
+}
+
+
#define WALK_SUBEXPR(NODE) \
do \
{ \
@@ -1383,6 +1553,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code
break;
case EXEC_DO:
+ do_level ++;
WALK_SUBEXPR (co->ext.iterator->var);
WALK_SUBEXPR (co->ext.iterator->start);
WALK_SUBEXPR (co->ext.iterator->end);
@@ -1601,6 +1772,9 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code
if (co->op == EXEC_FORALL)
forall_level --;
+ if (co->op == EXEC_DO)
+ do_level --;
+
in_omp_workshare = saved_in_omp_workshare;
}
}