From 305a35dafbd7b88c152022a91e25f0e0e2bc79fe Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Sun, 25 Nov 2012 17:24:09 +0000 Subject: [PATCH] re PR fortran/30146 (Redefining do-variable in excecution cycle) 2012-11-25 Thomas Koenig 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 PR fortran/30146 * gfortran.dg/do_check_6.f90: New test. From-SVN: r193793 --- gcc/fortran/ChangeLog | 12 ++ gcc/fortran/frontend-passes.c | 181 ++++++++++++++++++++++- gcc/testsuite/ChangeLog | 5 + gcc/testsuite/gfortran.dg/do_check_7.f90 | 40 +++++ 4 files changed, 236 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/do_check_7.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7f8e6dc8289..bf5f8fbad5b 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,15 @@ +2012-11-25 Thomas Koenig + + 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 PR fortran/55314 diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 287807efbc3..6679368994b 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -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; iext.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; iext.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; } } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index eb23b003a7e..833f7714296 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2012-11-25 Thomas Koenig + + PR fortran/30146 + * gfortran.dg/do_check_7.f90: New test. + 2012-11-24 Paolo Carlini PR c++/55446 diff --git a/gcc/testsuite/gfortran.dg/do_check_7.f90 b/gcc/testsuite/gfortran.dg/do_check_7.f90 new file mode 100644 index 00000000000..96487225688 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/do_check_7.f90 @@ -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