[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, 29 insertions, 121 deletions

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 582bb92..69d2c51 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -4322,131 +4322,39 @@ gfc_resolve_iterator (gfc_iterator *iter, bool real_ok)
 }
 
 
-/* Check whether the FORALL index appears in the expression or not.
-   Returns SUCCESS if SYM is found in EXPR.  */
+/* Traversal function for find_forall_index.  f == 2 signals that
+   that variable itself is not to be checked - only the references.  */
 
-static try
-find_forall_index (gfc_expr *expr, gfc_symbol *symbol)
+static bool
+forall_index (gfc_expr *expr, gfc_symbol *sym, int *f)
 {
-  gfc_array_ref ar;
-  gfc_ref *tmp;
-  gfc_actual_arglist *args;
-  int i;
+  gcc_assert (expr->expr_type == EXPR_VARIABLE);
 
-  if (!expr)
-    return FAILURE;
-
-  switch (expr->expr_type)
+  /* A scalar assignment  */
+  if (!expr->ref || *f == 1)
     {
-    case EXPR_VARIABLE:
-      gcc_assert (expr->symtree->n.sym);
-
-      /* A scalar assignment  */
-      if (!expr->ref)
-	{
-	  if (expr->symtree->n.sym == symbol)
-	    return SUCCESS;
-	  else
-	    return FAILURE;
-	}
-
-      /* the expr is array ref, substring or struct component.  */
-      tmp = expr->ref;
-      while (tmp != NULL)
-	{
-	  switch (tmp->type)
-	    {
-	    case  REF_ARRAY:
-	      /* Check if the symbol appears in the array subscript.  */
-	      ar = tmp->u.ar;
-	      for (i = 0; i < GFC_MAX_DIMENSIONS; i++)
-		{
-		  if (ar.start[i])
-		    if (find_forall_index (ar.start[i], symbol) == SUCCESS)
-		      return SUCCESS;
-
-		  if (ar.end[i])
-		    if (find_forall_index (ar.end[i], symbol) == SUCCESS)
-		      return SUCCESS;
-
-		  if (ar.stride[i])
-		    if (find_forall_index (ar.stride[i], symbol) == SUCCESS)
-		      return SUCCESS;
-		}  /* end for  */
-	      break;
-
-	    case REF_SUBSTRING:
-	      if (expr->symtree->n.sym == symbol)
-		return SUCCESS;
-	      tmp = expr->ref;
-	      /* Check if the symbol appears in the substring section.  */
-	      if (find_forall_index (tmp->u.ss.start, symbol) == SUCCESS)
-		return SUCCESS;
-	      if (find_forall_index (tmp->u.ss.end, symbol) == SUCCESS)
-		return SUCCESS;
-	      break;
-
-	    case REF_COMPONENT:
-	      break;
-
-	    default:
-	      gfc_error("expression reference type error at %L", &expr->where);
-	    }
-	  tmp = tmp->next;
-	}
-      break;
-
-    /* If the expression is a function call, then check if the symbol
-       appears in the actual arglist of the function.  */
-    case EXPR_FUNCTION:
-      for (args = expr->value.function.actual; args; args = args->next)
-	{
-	  if (find_forall_index(args->expr,symbol) == SUCCESS)
-	    return SUCCESS;
-	}
-      break;
-
-    /* It seems not to happen.  */
-    case EXPR_SUBSTRING:
-      if (expr->ref)
-	{
-	  tmp = expr->ref;
-	  gcc_assert (expr->ref->type == REF_SUBSTRING);
-	  if (find_forall_index (tmp->u.ss.start, symbol) == SUCCESS)
-	    return SUCCESS;
-	  if (find_forall_index (tmp->u.ss.end, symbol) == SUCCESS)
-	    return SUCCESS;
-	}
-      break;
-
-    /* It seems not to happen.  */
-    case EXPR_STRUCTURE:
-    case EXPR_ARRAY:
-      gfc_error ("Unsupported statement while finding forall index in "
-		 "expression");
-      break;
+      if (expr->symtree->n.sym == sym)
+	return true;
+      else
+	return false;
+    }
 
-    case EXPR_OP:
-      /* Find the FORALL index in the first operand.  */
-      if (expr->value.op.op1)
-	{
-	  if (find_forall_index (expr->value.op.op1, symbol) == SUCCESS)
-	    return SUCCESS;
-	}
+  if (*f == 2)
+    *f = 1;
+  return false;
+}
 
-      /* Find the FORALL index in the second operand.  */
-      if (expr->value.op.op2)
-	{
-	  if (find_forall_index (expr->value.op.op2, symbol) == SUCCESS)
-	    return SUCCESS;
-	}
-      break;
 
-    default:
-      break;
-    }
+/* Check whether the FORALL index appears in the expression or not.
+   Returns SUCCESS if SYM is found in EXPR.  */
 
-  return FAILURE;
+try
+find_forall_index (gfc_expr *expr, gfc_symbol *sym, int f)
+{
+  if (gfc_traverse_expr (expr, sym, forall_index, f))
+    return SUCCESS;
+  else
+    return FAILURE;
 }
 
 
@@ -4502,11 +4410,11 @@ resolve_forall_iterators (gfc_forall_iterator *it)
     for (iter2 = iter; iter2; iter2 = iter2->next)
       {
 	if (find_forall_index (iter2->start,
-			       iter->var->symtree->n.sym) == SUCCESS
+			       iter->var->symtree->n.sym, 0) == SUCCESS
 	    || find_forall_index (iter2->end,
-				  iter->var->symtree->n.sym) == SUCCESS
+				  iter->var->symtree->n.sym, 0) == SUCCESS
 	    || find_forall_index (iter2->stride,
-				  iter->var->symtree->n.sym) == SUCCESS)
+				  iter->var->symtree->n.sym, 0) == SUCCESS)
 	  gfc_error ("FORALL index '%s' may not appear in triplet "
 		     "specification at %L", iter->var->symtree->name,
 		     &iter2->start->where);
@@ -5726,7 +5634,7 @@ gfc_resolve_assign_in_forall (gfc_code *code, int nvar, gfc_expr **var_expr)
 	  /* If one of the FORALL index variables doesn't appear in the
 	     assignment target, then there will be a many-to-one
 	     assignment.  */
-	  if (find_forall_index (code->expr, forall_index) == FAILURE)
+	  if (find_forall_index (code->expr, forall_index, 0) == FAILURE)
 	    gfc_error ("The FORALL with index '%s' cause more than one "
 		       "assignment to this object at %L",
 		       var_expr[n]->symtree->name, &code->expr->where);