Skip to content

R
riscv-gcc-1
Commit 4fe70c9b by Paul Thomas
Options

re PR fortran/25029 (Assumed size array can be associated with array pointer… 

re PR fortran/25029 (Assumed size array can be associated with array pointer without upper bound of last dimension)

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.

From-SVN: r109039
parent 5f5c25d9
Showing with 16 additions and 126 deletions
gcc/fortran/ChangeLog
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
......
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;
}
......
gcc/testsuite/ChangeLog
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
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" }
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment