[multiple changes]

2007-10-29  Paul Thomas  <pault@gcc.gnu.org>

        PR fortran/31217
        PR fortran/33811
        PR fortran/33686
        * trans-array.c (gfc_conv_loop_setup): Send a complete type to
        gfc_trans_create_temp_array if the temporary is character.
        * trans-stmt.c (gfc_trans_assign_need_temp): Do likewise for
        allocate_temp_for_forall_nest.
        (forall_replace): New function.
        (forall_replace_symtree): New function.
        (forall_restore): New function.
        (forall_restore_symtree): New function.
        (forall_make_variable_temp): New function.
        (check_forall_dependencies): New function.
        (cleanup_forall_symtrees): New function.
        gfc_trans_forall_1): Add and initialize pre and post blocks.
        Call check_forall_dependencies to check for all dependencies
        and either trigger second forall block to copy temporary or
        copy lval, outside the forall construct and replace all
        dependent references. After assignment clean-up and coalesce
        the blocks at the end of the function.
        * gfortran.h : Add prototypes for gfc_traverse_expr and
        find_forall_index.
        expr.c (gfc_traverse_expr): New function to traverse expression
        and visit all subexpressions, under control of a logical flag,
        a symbol and an integer pointer. The slave function is caller
        defined and is only called on EXPR_VARIABLE.
        (expr_set_symbols_referenced): Called by above to set symbols
        referenced.
        (gfc_expr_set_symbols_referenced): Rework of this function to
        use two new functions above.
        * resolve.c (find_forall_index): Rework with gfc_traverse_expr,
        using forall_index.
        (forall_index): New function used by previous.
        * dependency.c (gfc_check_dependency): Use gfc_dep_resolver for
        all references, not just REF_ARRAY.
        (gfc_dep_resolver): Correct the logic for substrings so that
        overlapping arrays are handled correctly.

2007-10-29 Paul Thomas <pault@gcc.gnu.org>

        PR fortran/31217
        PR fortran/33811
        * gfortran.dg/forall_12.f90: New test.

        PR fortran/33686
        * gfortran.dg/forall_13.f90: New test.

From-SVN: r129720

1 files changed, 68 insertions, 30 deletions

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 2edf7ad..c7edb49 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -2998,32 +2998,36 @@ gfc_get_variable_expr (gfc_symtree *var)
 }
 
 
-/* Traverse expr, marking all EXPR_VARIABLE symbols referenced.  */
+/* General expression traversal function.  */
 
-void
-gfc_expr_set_symbols_referenced (gfc_expr *expr)
+bool
+gfc_traverse_expr (gfc_expr *expr, gfc_symbol *sym,
+		   bool (*func)(gfc_expr *, gfc_symbol *, int*),
+		   int f)
 {
-  gfc_actual_arglist *arg;
-  gfc_constructor *c;
+  gfc_array_ref ar;
   gfc_ref *ref;
+  gfc_actual_arglist *args;
+  gfc_constructor *c;
   int i;
 
-  if (!expr) return;
+  if (!expr)
+    return false;
 
   switch (expr->expr_type)
     {
-    case EXPR_OP:
-      gfc_expr_set_symbols_referenced (expr->value.op.op1);
-      gfc_expr_set_symbols_referenced (expr->value.op.op2);
-      break;
+    case EXPR_VARIABLE:
+      gcc_assert (expr->symtree->n.sym);
 
-    case EXPR_FUNCTION:
-      for (arg = expr->value.function.actual; arg; arg = arg->next)
-	gfc_expr_set_symbols_referenced (arg->expr);
-      break;
+      if ((*func) (expr, sym, &f))
+	return true;
 
-    case EXPR_VARIABLE:
-      gfc_set_sym_referenced (expr->symtree->n.sym);
+    case EXPR_FUNCTION:
+      for (args = expr->value.function.actual; args; args = args->next)
+	{
+	  if (gfc_traverse_expr (args->expr, sym, func, f))
+	    return true;
+	}
       break;
 
     case EXPR_CONSTANT:
@@ -3037,33 +3041,67 @@ gfc_expr_set_symbols_referenced (gfc_expr *expr)
 	gfc_expr_set_symbols_referenced (c->expr);
       break;
 
+    case EXPR_OP:
+      if (gfc_traverse_expr (expr->value.op.op1, sym, func, f))
+	return true;
+      if (gfc_traverse_expr (expr->value.op.op2, sym, func, f))
+	return true;
+      break;
+
     default:
       gcc_unreachable ();
       break;
     }
 
-    for (ref = expr->ref; ref; ref = ref->next)
+  ref = expr->ref;
+  while (ref != NULL)
+    {
       switch (ref->type)
 	{
-	case REF_ARRAY:
-	  for (i = 0; i < ref->u.ar.dimen; i++)
+	case  REF_ARRAY:
+	  ar = ref->u.ar;
+	  for (i = 0; i < GFC_MAX_DIMENSIONS; i++)
 	    {
-	      gfc_expr_set_symbols_referenced (ref->u.ar.start[i]);
-	      gfc_expr_set_symbols_referenced (ref->u.ar.end[i]);
-	      gfc_expr_set_symbols_referenced (ref->u.ar.stride[i]);
+	      if (gfc_traverse_expr (ar.start[i], sym, func, f))
+		return true;
+	      if (gfc_traverse_expr (ar.end[i], sym, func, f))
+		return true;
+	      if (gfc_traverse_expr (ar.stride[i], sym, func, f))
+		return true;
 	    }
 	  break;
-	   
-	case REF_COMPONENT:
-	  break;
-	   
+
 	case REF_SUBSTRING:
-	  gfc_expr_set_symbols_referenced (ref->u.ss.start);
-	  gfc_expr_set_symbols_referenced (ref->u.ss.end);
+	  if (gfc_traverse_expr (ref->u.ss.start, sym, func, f))
+	    return true;
+	  if (gfc_traverse_expr (ref->u.ss.end, sym, func, f))
+	    return true;
 	  break;
-	   
+
+	  case REF_COMPONENT:
+	    break;
+
 	default:
 	  gcc_unreachable ();
-	  break;
 	}
+      ref = ref->next;
+    }
+  return false;
+}
+
+/* Traverse expr, marking all EXPR_VARIABLE symbols referenced.  */
+
+static bool
+expr_set_symbols_referenced (gfc_expr *expr,
+			     gfc_symbol *sym ATTRIBUTE_UNUSED,
+			     int *f ATTRIBUTE_UNUSED)
+{
+  gfc_set_sym_referenced (expr->symtree->n.sym);
+  return false;
+}
+
+void
+gfc_expr_set_symbols_referenced (gfc_expr *expr)
+{
+  gfc_traverse_expr (expr, NULL, expr_set_symbols_referenced, 0);
 }