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, 9 insertions, 44 deletions

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index f769651..fe2a343 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -3209,13 +3209,12 @@ cleanup:
    12.5.4 requires that any variable of function that is implicitly typed
    shall have that type confirmed by any subsequent type declaration.  The
    implicit typing is conveniently done here.  */
+static bool
+recursive_stmt_fcn (gfc_expr *, gfc_symbol *);
 
 static bool
-recursive_stmt_fcn (gfc_expr *e, gfc_symbol *sym)
+check_stmt_fcn (gfc_expr *e, gfc_symbol *sym, int *f ATTRIBUTE_UNUSED)
 {
-  gfc_actual_arglist *arg;
-  gfc_ref *ref;
-  int i;
 
   if (e == NULL)
     return false;
@@ -3223,12 +3222,6 @@ recursive_stmt_fcn (gfc_expr *e, gfc_symbol *sym)
   switch (e->expr_type)
     {
     case EXPR_FUNCTION:
-      for (arg = e->value.function.actual; arg; arg = arg->next)
-	{
-	  if (sym->name == arg->name || recursive_stmt_fcn (arg->expr, sym))
-	    return true;
-	}
-
       if (e->symtree == NULL)
 	return false;
 
@@ -3255,46 +3248,18 @@ recursive_stmt_fcn (gfc_expr *e, gfc_symbol *sym)
 	gfc_set_default_type (e->symtree->n.sym, 0, NULL);
       break;
 
-    case EXPR_OP:
-      if (recursive_stmt_fcn (e->value.op.op1, sym)
-	  || recursive_stmt_fcn (e->value.op.op2, sym))
-	return true;
-      break;
-
     default:
       break;
     }
 
-  /* Component references do not need to be checked.  */
-  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++)
-		{
-		  if (recursive_stmt_fcn (ref->u.ar.start[i], sym)
-		      || recursive_stmt_fcn (ref->u.ar.end[i], sym)
-		      || recursive_stmt_fcn (ref->u.ar.stride[i], sym))
-		    return true;
-		}
-	      break;
-
-	    case REF_SUBSTRING:
-	      if (recursive_stmt_fcn (ref->u.ss.start, sym)
-		  || recursive_stmt_fcn (ref->u.ss.end, sym))
-		return true;
+  return false;
+}
 
-	      break;
 
-	    default:
-	      break;
-	    }
-	}
-    }
-  return false;
+static bool
+recursive_stmt_fcn (gfc_expr *e, gfc_symbol *sym)
+{
+  return gfc_traverse_expr (e, sym, check_stmt_fcn, 0);
 }