diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2006-04-23 11:56:37 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2006-04-23 11:56:37 +0000 |
| commit | c9379bf062307760ddf408620d5e233700583c78 (patch) | |
| tree | c661259a0ba7d90009650c4ba358c303a57575ac /gcc/fortran/resolve.c | |
| parent | db03587b6c2a9b2f3b8c5c9da7e40000f752c621 (diff) | |
| download | gcc-c9379bf062307760ddf408620d5e233700583c78.zip gcc-c9379bf062307760ddf408620d5e233700583c78.tar.gz gcc-c9379bf062307760ddf408620d5e233700583c78.tar.bz2 | |
re PR fortran/25099 (Conformance of arguments to ELEMENTAL subroutines)
2006-04-23 Paul Thomas <pault@gcc.gnu.org>
PR fortran/25099
* resolve.c (resolve_call): Check conformity of elemental
subroutine actual arguments.
2006-04-23 Paul Thomas <pault@gcc.gnu.org>
PR fortran/25099
* gfortran.dg/elemental_subroutine_4.f90: New test.
* gfortran.dg/assumed_size_refs_1.f90: Add error to non-conforming
call sub (m, x).
From-SVN: r113194
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 25 |
1 files changed, 20 insertions, 5 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index fce2322..1e57add 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1657,18 +1657,33 @@ resolve_call (gfc_code * c) gfc_internal_error ("resolve_subroutine(): bad function type"); } + /* Some checks of elemental subroutines. */ 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. */ + gfc_expr * e; + e = NULL; + for (a = c->ext.actual; a; a = a->next) { - if (a->expr != NULL - && a->expr->rank > 0 - && resolve_assumed_size_actual (a->expr)) + if (a->expr == NULL || a->expr->rank == 0) + continue; + + /* The last upper bound of an assumed size array argument must + be present. */ + if (resolve_assumed_size_actual (a->expr)) return FAILURE; + + /* Array actual arguments must conform. */ + if (e != NULL) + { + if (gfc_check_conformance ("elemental subroutine", a->expr, e) + == FAILURE) + return FAILURE; + } + else + e = a->expr; } } |