From: Mikael Morin Date: Thu, 26 Jul 2012 08:47:33 +0000 (+0000) Subject: re PR fortran/44354 (implied do loop with its own variable name as upper bound) X-Git-Tag: releases/gcc-4.8.0~4261 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=ca27d5aebd6c4a4fb2776f2924da621c26b5fd1a;p=thirdparty%2Fgcc.git re PR fortran/44354 (implied do loop with its own variable name as upper bound) fortran/ PR fortran/44354 * array.c (sought_symbol): New variable. (expr_is_sought_symbol_ref, find_symbol_in_expr): New functions. (resolve_array_list): Check for references to the induction variable in the iteration bounds and issue a diagnostic if some are found. testsuite/ PR fortran/44354 * gfortran.dg/array_constructor_38.f90: New test. From-SVN: r189882 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 136f504bfea5..3c68cbfdc33c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2012-07-26 Mikael Morin + + PR fortran/44354 + * array.c (sought_symbol): New variable. + (expr_is_sought_symbol_ref, find_symbol_in_expr): New functions. + (resolve_array_list): Check for references to the induction + variable in the iteration bounds and issue a diagnostic if some + are found. + 2012-07-26 Alessandro Fanfarillo Tobias Burnus diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index 1b700b81109d..76bd5c3d63dd 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -1748,6 +1748,50 @@ gfc_expanded_ac (gfc_expr *e) /*************** Type resolution of array constructors ***************/ + +/* The symbol expr_is_sought_symbol_ref will try to find. */ +static const gfc_symbol *sought_symbol = NULL; + + +/* Tells whether the expression E is a variable reference to the symbol + in the static variable SOUGHT_SYMBOL, and sets the locus pointer WHERE + accordingly. + To be used with gfc_expr_walker: if a reference is found we don't need + to look further so we return 1 to skip any further walk. */ + +static int +expr_is_sought_symbol_ref (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, + void *where) +{ + gfc_expr *expr = *e; + locus *sym_loc = (locus *)where; + + if (expr->expr_type == EXPR_VARIABLE + && expr->symtree->n.sym == sought_symbol) + { + *sym_loc = expr->where; + return 1; + } + + return 0; +} + + +/* Tells whether the expression EXPR contains a reference to the symbol + SYM and in that case sets the position SYM_LOC where the reference is. */ + +static bool +find_symbol_in_expr (gfc_symbol *sym, gfc_expr *expr, locus *sym_loc) +{ + int ret; + + sought_symbol = sym; + ret = gfc_expr_walker (&expr, &expr_is_sought_symbol_ref, sym_loc); + sought_symbol = NULL; + return ret; +} + + /* Recursive array list resolution function. All of the elements must be of the same type. */ @@ -1756,14 +1800,46 @@ resolve_array_list (gfc_constructor_base base) { gfc_try t; gfc_constructor *c; + gfc_iterator *iter; t = SUCCESS; for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c)) { - if (c->iterator != NULL - && gfc_resolve_iterator (c->iterator, false) == FAILURE) - t = FAILURE; + iter = c->iterator; + if (iter != NULL) + { + gfc_symbol *iter_var; + locus iter_var_loc; + + if (gfc_resolve_iterator (iter, false) == FAILURE) + t = FAILURE; + + /* Check for bounds referencing the iterator variable. */ + gcc_assert (iter->var->expr_type == EXPR_VARIABLE); + iter_var = iter->var->symtree->n.sym; + if (find_symbol_in_expr (iter_var, iter->start, &iter_var_loc)) + { + if (gfc_notify_std (GFC_STD_LEGACY, "AC-IMPLIED-DO initial " + "expression references control variable " + "at %L", &iter_var_loc) == FAILURE) + t = FAILURE; + } + if (find_symbol_in_expr (iter_var, iter->end, &iter_var_loc)) + { + if (gfc_notify_std (GFC_STD_LEGACY, "AC-IMPLIED-DO final " + "expression references control variable " + "at %L", &iter_var_loc) == FAILURE) + t = FAILURE; + } + if (find_symbol_in_expr (iter_var, iter->step, &iter_var_loc)) + { + if (gfc_notify_std (GFC_STD_LEGACY, "AC-IMPLIED-DO step " + "expression references control variable " + "at %L", &iter_var_loc) == FAILURE) + t = FAILURE; + } + } if (gfc_resolve_expr (c->expr) == FAILURE) t = FAILURE; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ff338d5fab3a..16d56aee9bfc 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2012-07-26 Mikael Morin + + PR fortran/44354 + * gfortran.dg/array_constructor_38.f90: New test. + 2012-07-25 Janis Johnson * g++.dg/cpp0x/nullptr21.c: Remove printfs, make self-checking. diff --git a/gcc/testsuite/gfortran.dg/array_constructor_38.f90 b/gcc/testsuite/gfortran.dg/array_constructor_38.f90 new file mode 100644 index 000000000000..961e5803206a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_38.f90 @@ -0,0 +1,16 @@ +! { dg-do compile } +! { dg-options "-std=f95" } +! +! PR fortran/44354 +! array constructors were giving unexpected results when the ac-implied-do +! variable was used in one of the ac-implied-do bounds. +! +! Original testcase by Vittorio Zecca +! + I=5 + print *,(/(i,i=I,8)/) ! { dg-error "initial expression references control variable" } + print *,(/(i,i=1,I)/) ! { dg-error "final expression references control variable" } + print *,(/(i,i=1,50,I)/) ! { dg-error "step expression references control variable" } + end + +