2005-12-24 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/25029
	PR fortran/21256
	* resolve.c (check_assumed_size_reference, resolve_assumed_size_actual):
	Remove because of regressions caused by patch.
	(resolve_function, resolve_call, resolve_variable): Remove assumed size
	checks because of regressionscaused by patch.

	PR fortran/25029
	PR fortran/21256
	* gfortran.dg/initialization_1.f90: Remove tests of intrinsic functions
	with incorrect assumed size references.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@109039 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 0 insertions, 122 deletions

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 4966a633c2a..63c9abde22c 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -695,68 +695,6 @@ procedure_kind (gfc_symbol * sym)
   return PTYPE_UNKNOWN;
 }
 
-/* Check references to assumed size arrays.  The flag need_full_assumed_size
-   is zero when matching actual arguments.  */
-
-static int need_full_assumed_size = 1;
-
-static int
-check_assumed_size_reference (gfc_symbol * sym, gfc_expr * e)
-{
-  gfc_ref * ref;
-  int dim;
-  int last = 1;
-
-  if (!need_full_assumed_size
-	|| !(sym->as && sym->as->type == AS_ASSUMED_SIZE))
-      return 0;
-
-  for (ref = e->ref; ref; ref = ref->next)
-    if (ref->type == REF_ARRAY)
-      for (dim = 0; dim < ref->u.ar.as->rank; dim++)
-	last = (ref->u.ar.end[dim] == NULL) && (ref->u.ar.type == DIMEN_ELEMENT);
-
-  if (last)
-    {
-      gfc_error ("The upper bound in the last dimension must "
-		 "appear in the reference to the assumed size "
-		 "array '%s' at %L.", sym->name, &e->where);
-      return 1;
-    }
-  return 0;
-}
-
-
-/* Look for bad assumed size array references in argument expressions
-  of elemental and array valued intrinsic procedures.  Since this is
-  called from procedure resolution functions, it only recurses at
-  operators.  */
-static bool
-resolve_assumed_size_actual (gfc_expr *e)
-{
-  if (e == NULL)
-   return false;
-
-  switch (e->expr_type)
-    {
-    case EXPR_VARIABLE:
-      if (e->symtree
-	    && check_assumed_size_reference (e->symtree->n.sym, e))
-	return true;
-      break;
-
-    case EXPR_OP:
-      if (resolve_assumed_size_actual (e->value.op.op1)
-	    || resolve_assumed_size_actual (e->value.op.op2))
-	return true;
-      break;
-
-    default:
-      break;
-    }
-  return false;
-}
-
 
 /* Resolve an actual argument list.  Most of the time, this is just
    resolving the expressions in the list.
@@ -1154,16 +1092,9 @@ resolve_function (gfc_expr * expr)
   const char *name;
   try t;
 
-  /* Switch off assumed size checking and do this again for certain kinds
-     of procedure, once the procedure itself is resolved.  */
-  need_full_assumed_size = 0;
-
   if (resolve_actual_arglist (expr->value.function.actual) == FAILURE)
     return FAILURE;
 
-  /* Resume assumed_size checking. */
-  need_full_assumed_size = 1;
-
 /* See if function is already resolved.  */
 
   if (expr->value.function.name != NULL)
@@ -1217,33 +1148,6 @@ resolve_function (gfc_expr * expr)
 	      break;
 	    }
 	}
-
-      /* Being elemental, the last upper bound of an assumed size array
-	 argument must be present.  */
-      for (arg = expr->value.function.actual; arg; arg = arg->next)
-	{
-	  if (arg->expr != NULL
-		&& arg->expr->rank > 0
-		&& resolve_assumed_size_actual (arg->expr))
-	    return FAILURE;
-	}
-    }
-
-  else if (expr->value.function.actual != NULL
-      && expr->value.function.isym != NULL
-      && strcmp (expr->value.function.isym->name, "lbound")
-      && strcmp (expr->value.function.isym->name, "ubound")
-      && strcmp (expr->value.function.isym->name, "size"))
-    {
-      /* Array instrinsics must also have the last upper bound of an
-	 asumed size array argument.  */
-      for (arg = expr->value.function.actual; arg; arg = arg->next)
-	{
-	  if (arg->expr != NULL
-		&& arg->expr->rank > 0
-		&& resolve_assumed_size_actual (arg->expr))
-	    return FAILURE;
-	}
     }
 
   if (!pure_function (expr, &name))
@@ -1485,17 +1389,9 @@ resolve_call (gfc_code * c)
 {
   try t;
 
-  /* Switch off assumed size checking and do this again for certain kinds
-     of procedure, once the procedure itself is resolved.  */
-  need_full_assumed_size = 0;
-
   if (resolve_actual_arglist (c->ext.actual) == FAILURE)
     return FAILURE;
 
-  /* Resume assumed_size checking. */
-  need_full_assumed_size = 1;
-
-
   t = SUCCESS;
   if (c->resolved_sym == NULL)
     switch (procedure_kind (c->symtree->n.sym))
@@ -1516,21 +1412,6 @@ resolve_call (gfc_code * c)
 	gfc_internal_error ("resolve_subroutine(): bad function type");
       }
 
-  if (c->ext.actual != NULL
-      && c->symtree->n.sym->attr.elemental)
-    {
-      gfc_actual_arglist * a;
-      /* Being elemental, the last upper bound of an assumed size array
-	 argument must be present.  */
-      for (a = c->ext.actual; a; a = a->next)
-	{
-	  if (a->expr != NULL
-		&& a->expr->rank > 0
-		&& resolve_assumed_size_actual (a->expr))
-	    return FAILURE;
-	}
-    }
-
   if (t == SUCCESS)
     find_noncopying_intrinsics (c->resolved_sym, c->ext.actual);
   return t;
@@ -2457,9 +2338,6 @@ resolve_variable (gfc_expr * e)
       e->ts = sym->ts;
     }
 
-  if (check_assumed_size_reference (sym, e))
-    return FAILURE;
-
   return SUCCESS;
 }