re PR fortran/30146 (Redefining do-variable in excecution cycle)
2012-11-25 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/30146 * frontend-passes.c (doloop_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-25 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/30146 * gfortran.dg/do_check_6.f90: New test. From-SVN: r193793
This commit is contained in:
Thomas Koenig
parent
99303b325e
commit
305a35dafb
|
|
@ -1,3 +1,15 @@
|
|||
2012-11-25 Thomas Koenig <tkoenig@gcc.gnu.org>
|
||||
|
||||
PR fortran/30146
|
||||
* frontend-passes.c (doloop_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-24 Thomas Koenig <tkoenig@gcc.gnu.org>
|
||||
|
||||
PR fortran/55314
|
||||
|
|
|
|||
|
|
@ -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 is_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 codefn, walk_expr_fn_t exprfn,
|
|||
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 codefn, walk_expr_fn_t exprfn,
|
|||
if (co->op == EXEC_FORALL)
|
||||
forall_level --;
|
||||
|
||||
if (co->op == EXEC_DO)
|
||||
doloop_level --;
|
||||
|
||||
in_omp_workshare = saved_in_omp_workshare;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,3 +1,8 @@
|
|||
2012-11-25 Thomas Koenig <tkoenig@gcc.gnu.org>
|
||||
|
||||
PR fortran/30146
|
||||
* gfortran.dg/do_check_7.f90: New test.
|
||||
|
||||
2012-11-24 Paolo Carlini <paolo.carlini@oracle.com>
|
||||
|
||||
PR c++/55446
|
||||
|
|
|
|||
|
|
@ -0,0 +1,40 @@
|
|||
! { 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
|
||||
Loading…
Reference in New Issue