]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
re PR fortran/44354 (implied do loop with its own variable name as upper bound)
authorMikael Morin <mikael@gcc.gnu.org>
Thu, 26 Jul 2012 08:47:33 +0000 (08:47 +0000)
committerMikael Morin <mikael@gcc.gnu.org>
Thu, 26 Jul 2012 08:47:33 +0000 (08:47 +0000)
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

gcc/fortran/ChangeLog
gcc/fortran/array.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/array_constructor_38.f90 [new file with mode: 0644]

index 136f504bfea56799c97e093db3016c5c3489d818..3c68cbfdc33c8d421d00c746e52c9d0f69e8b2d1 100644 (file)
@@ -1,3 +1,12 @@
+2012-07-26  Mikael Morin  <mikael@gcc.gnu.org>
+
+       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  <fanfarillo.gcc@gmail.com>
            Tobias Burnus  <burnus@net-b.de>
 
index 1b700b81109def13f7eae4784af9a9ddab57c004..76bd5c3d63ddc774e8b79097160fe78653f28a0c 100644 (file)
@@ -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;
index ff338d5fab3a234df01707fe93ce2c0024b1829f..16d56aee9bfcb41aa5c6ccf5684401346022ce10 100644 (file)
@@ -1,3 +1,8 @@
+2012-07-26  Mikael Morin  <mikael@gcc.gnu.org>
+
+       PR fortran/44354
+       * gfortran.dg/array_constructor_38.f90: New test.
+
 2012-07-25  Janis Johnson  <janisjo@codesourcery.com>
 
        * 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 (file)
index 0000000..961e580
--- /dev/null
@@ -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 <zeccav@gmail.com>
+!
+      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
+
+