re PR fortran/25056 (non-PURE function should not be a valid argument)

2006-06-25  Paul Thomas  <pault@gcc.gnu.org>
 
	PR fortran/25056
	* interface.c (compare_actual_formal): Signal an error if the formal
	argument is a pure procedure and the actual is not pure.

	PR fortran/27554
	* resolve.c (resolve_actual_arglist): If the type of procedure
	passed as an actual argument is not already declared, see if it is
	an intrinsic.

	PR fortran/25073
	* resolve.c (resolve_select): Use bits 1 and 2 of a new int to
	keep track of  the appearance of constant logical case expressions.
	Signal an error is either value appears more than once.

	PR fortran/20874
	* resolve.c (resolve_fl_procedure): Signal an error if an elemental
	function is not scalar valued.

	PR fortran/20867
	* match.c (recursive_stmt_fcn): Perform implicit typing of variables.

	PR fortran/22038
	* match.c (match_forall_iterator): Mark new variables as
	FL_UNKNOWN if the match fails.

	PR fortran/28119
	* match.c (gfc_match_forall): Remove extraneous call to
	gfc_match_eos.

	PR fortran/25072
	* resolve.c (resolve_code, resolve_function): Rework
	forall_flag scheme so that it is set and has a value of
	2, when the code->expr (ie. the forall mask) is resolved.
	This is used to change "block" to "mask" in the non-PURE
	error message.


2006-06-25  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/20867
	* gfortran.dg/stfunc_3.f90: New test.

	PR fortran/25056
	* gfortran.dg/impure_actual_1.f90: New test.

	PR fortran/20874
	* gfortran.dg/elemental_result_1.f90: New test.

	PR fortran/25073
	* gfortran.dg/select_7.f90: New test.

	PR fortran/27554
	* intrinsic_actual_1.f: New test.

	PR fortran/22038
	PR fortran/28119
	* gfortran.dg/forall_4.f90: New test.

	PR fortran/25072
	* gfortran.dg/forall_5.f90: New test.

From-SVN: r114987

1 files changed, 18 insertions, 4 deletions

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 0ad5e13..77594cb 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -2802,7 +2802,11 @@ cleanup:
 
 /* Check that a statement function is not recursive. This is done by looking
    for the statement function symbol(sym) by looking recursively through its
-   expression(e).  If a reference to sym is found, true is returned.  */
+   expression(e).  If a reference to sym is found, true is returned.  
+   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 *e, gfc_symbol *sym)
 {
@@ -2836,11 +2840,17 @@ recursive_stmt_fcn (gfc_expr *e, gfc_symbol *sym)
 	    && recursive_stmt_fcn (e->symtree->n.sym->value, sym))
 	return true;
 
+      if (e->symtree->n.sym->ts.type == BT_UNKNOWN)
+	gfc_set_default_type (e->symtree->n.sym, 0, NULL);
+
       break;
 
     case EXPR_VARIABLE:
       if (e->symtree && sym->name == e->symtree->n.sym->name)
 	return true;
+
+      if (e->symtree->n.sym->ts.type == BT_UNKNOWN)
+	gfc_set_default_type (e->symtree->n.sym, 0, NULL);
       break;
 
     case EXPR_OP:
@@ -3392,6 +3402,13 @@ syntax:
   m = MATCH_ERROR;
 
 cleanup:
+  /* Make sure that potential internal function references in the
+     mask do not get messed up.  */
+  if (iter->var
+	&& iter->var->expr_type == EXPR_VARIABLE
+	&& iter->var->symtree->n.sym->refs == 1)
+    iter->var->symtree->n.sym->attr.flavor = FL_UNKNOWN;
+
   gfc_current_locus = where;
   gfc_free_forall_iterator (iter);
   return m;
@@ -3586,9 +3603,6 @@ gfc_match_forall (gfc_statement * st)
   *c = new_st;
   c->loc = gfc_current_locus;
 
-  if (gfc_match_eos () != MATCH_YES)
-    goto syntax;
-
   gfc_clear_new_st ();
   new_st.op = EXEC_FORALL;
   new_st.expr = mask;