re PR fortran/29389 (Statement functions are not recognized as pure when they are)

2007-11-27  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/29389
	*resolve.c (resolve_ordinary_assign): Use find_sym_in_expr to
	test if a temporary should be written for a vector subscript
	on the lhs.

	PR fortran/33850
	* restore.c (pure_stmt_function): Add prototype and new
	function. Calls impure_stmt_fcn.
	(pure_function): Call it.
	(impure_stmt_fcn): New function.

	* expr.c (gfc_traverse_expr): Call *func for all expression
	types, not just variables. Add traversal of character lengths,
	iterators and component character lengths and arrayspecs.
	(expr_set_symbols_referenced): Return false if not a variable.
	* trans-stmt.c (forall_replace, forall_restore): Ditto.
	* resolve.c (forall_index): Ditto.
	(sym_in_expr): New function.
	(find_sym_in_expr): Rewrite to traverse expression calling
	sym_in_expr.
	*trans-decl.c (expr_decls): New function.
	(generate_expr_decls): Rewrite to traverse expression calling
	expr_decls.
	*match.c (check_stmt_fcn): New function.
	(recursive_stmt_fcn): Rewrite to traverse expression calling
	check_stmt_fcn.

2007-11-27  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/29389
	* gfortran.dg/stfunc_6.f90: New test.

	PR fortran/33850
	* gfortran.dg/assign_10.f90: New test.

From-SVN: r130472

1 files changed, 15 insertions, 69 deletions

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 3a38973..84e7226 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -2893,80 +2893,26 @@ gfc_generate_contained_functions (gfc_namespace * parent)
 static void
 generate_local_decl (gfc_symbol *);
 
-static void
-generate_expr_decls (gfc_symbol *sym, gfc_expr *e)
-{
-  gfc_actual_arglist *arg;
-  gfc_ref *ref;
-  int i;
-
-  if (e == NULL)
-    return;
-
-  switch (e->expr_type)
-    {
-    case EXPR_FUNCTION:
-      for (arg = e->value.function.actual; arg; arg = arg->next)
-	generate_expr_decls (sym, arg->expr);
-      break;
+/* Traverse expr, marking all EXPR_VARIABLE symbols referenced.  */
 
-    /* If the variable is not the same as the dependent, 'sym', and
-       it is not marked as being declared and it is in the same
-       namespace as 'sym', add it to the local declarations.  */
-    case EXPR_VARIABLE:
-      if (sym == e->symtree->n.sym
+static bool
+expr_decls (gfc_expr *e, gfc_symbol *sym,
+	    int *f ATTRIBUTE_UNUSED)
+{
+  if (e->expr_type != EXPR_VARIABLE
+	    || sym == e->symtree->n.sym
 	    || e->symtree->n.sym->mark
 	    || e->symtree->n.sym->ns != sym->ns)
-	return;
-
-      generate_local_decl (e->symtree->n.sym);
-      break;
-
-    case EXPR_OP:
-      generate_expr_decls (sym, e->value.op.op1);
-      generate_expr_decls (sym, e->value.op.op2);
-      break;
-
-    default:
-      break;
-    }
-
-  if (e->ref)
-    {
-      for (ref = e->ref; ref; ref = ref->next)
-	{
-	  switch (ref->type)
-	    {
-	    case REF_ARRAY:
-	      for (i = 0; i < ref->u.ar.dimen; i++)
-		{
-		  generate_expr_decls (sym, ref->u.ar.start[i]);
-		  generate_expr_decls (sym, ref->u.ar.end[i]);
-		  generate_expr_decls (sym, ref->u.ar.stride[i]);
-		}
-	      break;
+	return false;
 
-	    case REF_SUBSTRING:
-	      generate_expr_decls (sym, ref->u.ss.start);
-	      generate_expr_decls (sym, ref->u.ss.end);
-	      break;
+  generate_local_decl (e->symtree->n.sym);
+  return false;
+}
 
-	    case REF_COMPONENT:
-	      if (ref->u.c.component->ts.type == BT_CHARACTER
-		    && ref->u.c.component->ts.cl->length->expr_type
-						!= EXPR_CONSTANT)
-		generate_expr_decls (sym, ref->u.c.component->ts.cl->length);
-
-	      if (ref->u.c.component->as)
-	        for (i = 0; i < ref->u.c.component->as->rank; i++)
-		  {
-		    generate_expr_decls (sym, ref->u.c.component->as->lower[i]);
-		    generate_expr_decls (sym, ref->u.c.component->as->upper[i]);
-		  }
-	      break;
-	    }
-	}
-    }
+static void
+generate_expr_decls (gfc_symbol *sym, gfc_expr *e)
+{
+  gfc_traverse_expr (e, sym, expr_decls, 0);
 }