re PR fortran/25746 (Elemental assignment gives wrong result)

2006-05-21  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/25746
	* interface.c (gfc_extend_assign): Use new code EXEC_ASSIGN_CALL.
	* gfortran.h : Put EXEC_ASSIGN_CALL in enum.
	* trans-stmt.c (gfc_conv_elemental_dependencies): New function.
	(gfc_trans_call): Call it.  Add new boolian argument to flag
	need for dependency checking. Assert intent OUT and IN for arg1
	and arg2.
	(gfc_trans_forall_1): Use new code EXEC_ASSIGN_CALL.
	trans-stmt.h : Modify prototype of gfc_trans_call.
	trans.c (gfc_trans_code): Add call for EXEC_ASSIGN_CALL.
	st.c (gfc_free_statement): Free actual for EXEC_ASSIGN_CALL.
	* dependency.c (gfc_check_fncall_dependency): Don't check other
	against itself.

	PR fortran/25090
	* resolve.c : Remove resolving_index_expr.
	(entry_parameter): Remove.
	(gfc_resolve_expr, resolve_charlen, resolve_fl_variable): Remove
	calls to entry_parameter and references to resolving_index_expr.

	PR fortran/27584
	* check.c (gfc_check_associated): Replace NULL assert with an
	error message, since it is possible to generate bad code that
	has us fall through to here..

	PR fortran/19015
	* iresolve.c (maxloc, minloc): If DIM is not present, pass the
	rank of ARRAY as the shape of the result.  Otherwise, pass the
	shape of ARRAY, less the dimension DIM.
	(maxval, minval): The same, when DIM is present, otherwise no
	change.

2006-05-21  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/25746
	* gfortran.dg/elemental_subroutine_3.f90: New test.

	PR fortran/25090
	* gfortran.dg/entry_dummy_ref_1.f90: Remove.

	PR fortran/27584
	* gfortran.dg/associated_target_1.f90: New test.

	PR fortran/19015
	* gfortran.dg/maxloc_shape_1.f90: New test.

From-SVN: r113949

1 files changed, 9 insertions, 64 deletions

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index f106d05..0affecc 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -60,9 +60,6 @@ static int omp_workshare_flag;
    resets the flag each time that it is read.  */
 static int formal_arg_flag = 0;
 
-/* True if we are resolving a specification expression.  */
-static int resolving_index_expr = 0;
-
 int
 gfc_is_formal_arg (void)
 {
@@ -2683,43 +2680,6 @@ resolve_variable (gfc_expr * e)
 }
 
 
-/* Emits an error if the expression is a variable that is not a parameter
-   in all entry formal argument lists for the namespace.  */
-
-static void
-entry_parameter (gfc_expr *e)
-{
-  gfc_symbol *sym, *esym;
-  gfc_entry_list *entry;
-  gfc_formal_arglist *f;
-  bool p;
-
-
-  sym = e->symtree->n.sym;
-
-  if (sym->attr.use_assoc
-	|| !sym->attr.dummy
-	|| sym->ns != gfc_current_ns)
-    return;
-
-  entry = sym->ns->entries;
-  for (; entry; entry = entry->next)
-    {
-      esym = entry->sym;
-      p = false;
-      for (f = esym->formal; f && !p; f = f->next)
-	{
-	  if (f->sym && f->sym->name && sym->name == f->sym->name)
-	    p = true;
-	}
-      if (!p)
-	gfc_error ("%s at %L must be a parameter of the entry at %L",
-		   sym->name, &e->where, &esym->declared_at);
-    }
-  return;
-}
-
-
 /* Resolve an expression.  That is, make sure that types of operands agree
    with their operators, intrinsic operators are converted to function calls
    for overloaded types and unresolved function references are resolved.  */
@@ -2744,10 +2704,6 @@ gfc_resolve_expr (gfc_expr * e)
 
     case EXPR_VARIABLE:
       t = resolve_variable (e);
-
-      if (gfc_current_ns->entries && resolving_index_expr)
-	entry_parameter (e);
-
       if (t == SUCCESS)
 	expression_rank (e);
       break;
@@ -4699,6 +4655,7 @@ resolve_values (gfc_symbol * sym)
 static try
 resolve_index_expr (gfc_expr * e)
 {
+
   if (gfc_resolve_expr (e) == FAILURE)
     return FAILURE;
 
@@ -4721,12 +4678,9 @@ resolve_charlen (gfc_charlen *cl)
 
   cl->resolved = 1;
 
-  resolving_index_expr = 1;
-
   if (resolve_index_expr (cl->length) == FAILURE)
     return FAILURE;
 
-  resolving_index_expr = 0;
   return SUCCESS;
 }
 
@@ -4813,29 +4767,20 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
   if (resolve_fl_var_and_proc (sym, mp_flag) == FAILURE)
     return FAILURE;
 
-  /* Set this flag to check that variables are parameters of all entries.
-     This check is effected by the call to gfc_resolve_expr through
-     is_non_contant_shape_array.  */
-  resolving_index_expr = 1;
-
-  if (!sym->attr.use_assoc
+  /* The shape of a main program or module array needs to be constant.  */
+  if (sym->ns->proc_name
+	&& (sym->ns->proc_name->attr.flavor == FL_MODULE
+	     || sym->ns->proc_name->attr.is_main_program)
+	&& !sym->attr.use_assoc
 	&& !sym->attr.allocatable
 	&& !sym->attr.pointer
 	&& is_non_constant_shape_array (sym))
     {
-	/* The shape of a main program or module array needs to be constant.  */
-	if (sym->ns->proc_name
-	      && (sym->ns->proc_name->attr.flavor == FL_MODULE
-		    || sym->ns->proc_name->attr.is_main_program))
-	  {
-	    gfc_error ("The module or main program array '%s' at %L must "
-		       "have constant shape", sym->name, &sym->declared_at);
-	    return FAILURE;
-	  }
+       gfc_error ("The module or main program array '%s' at %L must "
+		     "have constant shape", sym->name, &sym->declared_at);
+	  return FAILURE;
     }
 
-  resolving_index_expr = 0;
-
   if (sym->ts.type == BT_CHARACTER)
     {
       /* Make sure that character string variables with assumed length are