Hi Steven,
On Sat, Nov 10, 2012 at 3:00 PM, Thomas Koenig wrote:
I wrote:
after the dicsussion on c.l.f, it become clear that passing a DO loop
variable to an INTENT(OUT) or INTENT(INOUT) dummy argument is an error.
The attached patch throws an error for both cases.
But should we really isse an error for INTENT(INOUT)? IMHO a warning
suffices, with maybe an error only for strict (i.e. non-GNU) standard
settings.
This was the result of a discussion on c.l.f. The summary can be found
http://groups.google.com/group/comp.lang.fortran/msg/7107f24b8980fad3?hl=de
Basically, passing an index variable to an INTENT(INOUT) variable
violates a requirement on the program, and than an error would be
the best course of action.
I chose to issue the errors as a front-end pass because we cannot check
for formal arguments during parsing (where the other checks are
implemented).
Regression-tested. OK for trunk?
Ping ** 1.4285 ?
You don't have to list do_list twice in the ChangeLog, you probably
wanted one of those to be do_level ;-)
OK.
+ do_list = XNEWVEC(gfc_code *, do_size);
Taste nit: Why not just toss do_list, do_level, and do_size around as
a function argument, instead of making them global variable? Just
define a struct containing them and pass it around via the "data"
argument for gfc_code_walker should work, I think.
The problem is with do_level. This could be incremented in do_warn,
but we only know when to decrement it in gfc_code_walker (because there
is no EXEC_ENDDO). So, we need a static variable in any case.
The rest is a question of taste. If we need one static variable, I think
we might as well use some other static variables. The only alternative
I thought about was using a VEC, but frankly the documentation on that
left me baffled as to how to implement this.
IMHO names like "do_warn" and "do_list" are not very descriptive, if
not to say confusing. do_* names are used elsewhere in the compiler
for functions that perform ("do") a task, whereas your do_* functions
are for the Fortran DO construct. I'd prefer different names.
Changed to doloop_*.
+ to an INTENt(OUT) or INTENT(INOUT) dummy variable. */
s/INTENt/INTENT/
Fixed.
+ /* Withot a formal arglist, there is only unknown INTENT,
s/Withot/Without/
+ for (i=0; i<do_level; i++)
for (i = 0; i < do_level; i++)
+ "inside loop beginning at %L as INTENT(OUT) "
Extraneous space after loop.
Fixed.
How do you handle OPTIONAL args?
As far as I have been able to determine, they work:
ig25@linux-fd1f:~/Krempel/Do> cat optional.f90
module opt
implicit none
contains
subroutine opt_in(a,b)
integer, intent(in), optional :: a
integer, intent(out) :: b
end subroutine opt_in
end module opt
program main
use opt
implicit none
integer :: i
do i=1,10
call opt_in(b=i)
end do
end program main
ig25@linux-fd1f:~/Krempel/Do> gfortran optional.f90
optional.f90:14.18:
call opt_in(b=i)
1
optional.f90:13.11:
do i=1,10
2
Fehler: Variable 'i' at (1) set to undefined value inside loop
beginning at (2) as INTENT(OUT) argument to subroutine 'opt_in'
Or were you thinking of another case?
Attached is the new version of the patch, regression-tested.
Thanks for the review!
OK for trunk?
Thomas
2012-11-11 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/30146
* frontend-passes.c (do_warn): New function.
(doloop_list): New static variable.
(doloop_size): New static variable.
(doloop_level): New static variable.
(gfc_run_passes): Call doloop_warn.
(doloop_code): New function.
(doloop_function): New function.
(gfc_code_walker): Keep track of DO level.
2012-11-11 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/30146
* gfortran.dg/do_check_6.f90: New test.
Index: frontend-passes.c
===================================================================
--- frontend-passes.c (Revision 192894)
+++ frontend-passes.c (Arbeitskopie)
@@ -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 doloop_warn (gfc_namespace *);
/* How deep we are inside an argument list. */
@@ -76,12 +77,30 @@ 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 **doloop_list;
+static int doloop_size, doloop_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. */
+
+ doloop_size = 20;
+ doloop_level = 0;
+ doloop_list = XNEWVEC(gfc_code *, doloop_size);
+ doloop_warn (ns);
+ XDELETEVEC (doloop_list);
+
if (gfc_option.flag_frontend_optimize)
{
expr_size = 20;
@@ -1225,6 +1244,160 @@ optimize_minmaxloc (gfc_expr **e)
mpz_set_ui (a->expr->value.integer, 1);
}
+/* Callback function for code checking that we do not pass a DO variable to an
+ INTENT(OUT) or INTENT(INOUT) dummy variable. */
+
+static int
+doloop_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:
+
+ /* Grow the temporary storage if necessary. */
+ if (doloop_level >= doloop_size)
+ {
+ doloop_size = 2 * doloop_size;
+ doloop_list = XRESIZEVEC (gfc_code *, doloop_list, doloop_size);
+ }
+
+ /* Mark the DO loop variable if there is one. */
+ if (co->ext.iterator && co->ext.iterator->var)
+ doloop_list[doloop_level] = co;
+ else
+ doloop_list[doloop_level] = NULL;
+ break;
+
+ case EXEC_CALL:
+ f = co->symtree->n.sym->formal;
+
+ /* Withot a formal arglist, there is only unknown INTENT,
+ which we don't check for. */
+ if (f == NULL)
+ break;
+
+ a = co->ext.actual;
+
+ while (a && f)
+ {
+ for (i=0; i<doloop_level; i++)
+ {
+ gfc_symbol *do_sym;
+
+ if (doloop_list[i] == NULL)
+ break;
+
+ do_sym = doloop_list[i]->ext.iterator->var->symtree->n.sym;
+
+ if (a->expr && a->expr->symtree
+ && a->expr->symtree->n.sym == do_sym)
+ {
+ if (f->sym->attr.intent == INTENT_OUT)
+ gfc_error_now("Variable '%s' at %L set to undefined value "
+ "inside loop beginning at %L as INTENT(OUT) "
+ "argument to subroutine '%s'", do_sym->name,
+ &a->expr->where, &doloop_list[i]->loc,
+ co->symtree->n.sym->name);
+ else if (f->sym->attr.intent == INTENT_INOUT)
+ gfc_error_now("Variable '%s' at %L not definable inside loop "
+ "beginning at %L as INTENT(INOUT) argument to "
+ "subroutine '%s'", do_sym->name,
+ &a->expr->where, &doloop_list[i]->loc,
+ co->symtree->n.sym->name);
+ }
+ }
+ a = a->next;
+ f = f->next;
+ }
+ break;
+
+ default:
+ break;
+ }
+ return 0;
+}
+
+/* Callback function for functions checking that we do not pass a DO variable
+ to an INTENT(OUT) or INTENT(INOUT) dummy variable. */
+
+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;
+
+ f = expr->symtree->n.sym->formal;
+
+ /* Without a formal arglist, there is only unknown INTENT,
+ which we don't check for. */
+ if (f == NULL)
+ return 0;
+
+ a = expr->value.function.actual;
+
+ while (a && f)
+ {
+ for (i=0; i<doloop_level; i++)
+ {
+ gfc_symbol *do_sym;
+
+
+ if (doloop_list[i] == NULL)
+ break;
+
+ do_sym = doloop_list[i]->ext.iterator->var->symtree->n.sym;
+
+ if (a->expr && a->expr->symtree
+ && a->expr->symtree->n.sym == do_sym)
+ {
+ if (f->sym->attr.intent == INTENT_OUT)
+ gfc_error_now("Variable '%s' at %L set to undefined value "
+ "inside loop beginning at %L as INTENT(OUT) "
+ "argument to function '%s'", do_sym->name,
+ &a->expr->where, &doloop_list[i]->loc,
+ expr->symtree->n.sym->name);
+ else if (f->sym->attr.intent == INTENT_INOUT)
+ gfc_error_now("Variable '%s' at %L not definable inside loop "
+ "beginning at %L as INTENT(INOUT) argument to "
+ "function '%s'", do_sym->name,
+ &a->expr->where, &doloop_list[i]->loc,
+ expr->symtree->n.sym->name);
+ }
+ }
+ a = a->next;
+ f = f->next;
+ }
+
+ return 0;
+}
+
+static void
+doloop_warn (gfc_namespace *ns)
+{
+ gfc_code_walker (&ns->code, doloop_code, do_function, NULL);
+}
+
+
#define WALK_SUBEXPR(NODE) \
do \
{ \
@@ -1383,6 +1556,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code
break;
case EXEC_DO:
+ doloop_level ++;
WALK_SUBEXPR (co->ext.iterator->var);
WALK_SUBEXPR (co->ext.iterator->start);
WALK_SUBEXPR (co->ext.iterator->end);
@@ -1601,6 +1775,9 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code
if (co->op == EXEC_FORALL)
forall_level --;
+ if (co->op == EXEC_DO)
+ doloop_level --;
+
in_omp_workshare = saved_in_omp_workshare;
}
}
! { dg-do compile }
! PR 30146 - warn about DO variables as argument to INTENT(IN) and
! INTENT(INOUT) dummy arguments
program main
implicit none
integer :: i,j, k, l
do k=1,2 ! { dg-error "undefined value" }
do i=1,10 ! { dg-error "definable" }
do j=1,10 ! { dg-error "undefined value" }
do l=1,10 ! { dg-error "definable" }
call s_out(k) ! { dg-error "undefined" }
call s_inout(i) ! { dg-error "definable" }
print *,f_out(j) ! { dg-error "undefined" }
print *,f_inout(l) ! { dg-error "definable" }
end do
end do
end do
end do
contains
subroutine s_out(i_arg)
integer, intent(out) :: i_arg
end subroutine s_out
subroutine s_inout(i_arg)
integer, intent(inout) :: i_arg
end subroutine s_inout
function f_out(i_arg)
integer, intent(out) :: i_arg
integer :: f_out
f_out = i_arg
end function f_out
function f_inout(i_arg)
integer, intent(inout) :: i_arg
integer :: f_inout
f_inout = i_arg
end function f_inout
end program main
