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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 4453d89..d3dafba 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+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.
+
 2005-12-23  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/25029

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 4966a63..63c9abd 100644 (file)
--- 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;
 }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 46f37f0..2d786b5 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2005-12-24  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/25029
+       PR fortran/21256
+       * gfortran.dg/initialization_1.f90: Remove tests of intrinsic functions
+       with incorrect assumed size references.
+
 2005-12-24  Mark Mitchell  <mark@codesourcery.com>
 
        PR c++/23171

diff --git a/gcc/testsuite/gfortran.dg/initialization_1.f90 b/gcc/testsuite/gfortran.dg/initialization_1.f90
index 4e85269..479348e 100644 (file)
--- a/gcc/testsuite/gfortran.dg/initialization_1.f90
+++ b/gcc/testsuite/gfortran.dg/initialization_1.f90
@@ -25,10 +25,6 @@ contains
 ! However, this gives a warning because it is an initialization expression.
     integer :: l1 = len (ch1)     ! { dg-warning "assumed character length variable" }
 
-! Dependence on upper bound of final dimension of assumed size array knocks these out.
-    integer :: m1 = size (x, 2)   ! { dg-error "not a valid dimension index" }
-    integer :: m2(2) = shape (x)  ! { dg-error "assumed size array" }
-
 ! These are warnings because they are gfortran extensions.
     integer :: m3 = size (x, 1)   ! { dg-warning "Evaluation of nonstandard initialization" }
     integer :: m4(2) = shape (z)  ! { dg-warning "Evaluation of nonstandard initialization" }