From d02358e8264544d461f0534323eb6616f5cec97e Mon Sep 17 00:00:00 2001 From: pault Date: Sat, 24 Dec 2005 12:05:36 +0000 Subject: [PATCH] 2005-12-24 Paul Thomas 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 --- gcc/fortran/ChangeLog | 9 ++ gcc/fortran/resolve.c | 122 ------------------------- gcc/testsuite/ChangeLog | 7 ++ gcc/testsuite/gfortran.dg/initialization_1.f90 | 4 - 4 files changed, 16 insertions(+), 126 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 4453d89..d3dafba 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2005-12-24 Paul Thomas + + 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 PR fortran/25029 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 4966a63..63c9abd 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; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 46f37f0..2d786b5 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2005-12-24 Paul Thomas + + 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 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 --- 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" } -- 2.7.4