mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-01-11 20:45:41 +08:00
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
This commit is contained in:
Paul Thomas
parent
5f5c25d99d
commit
4fe70c9b0d
@ -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
|
||||
|
||||
@ -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;
|
||||
}
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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" }
|
||||
|
||||
Loading…
Reference in New Issue
Block a user