diff options
| author | Tobias Burnus <burnus@net-b.de> | 2012-07-19 22:20:17 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2012-07-19 22:20:17 +0200 |
| commit | 3d333a280ffcb968aa3f561154fde4460ff5e429 (patch) | |
| tree | 184c424f1429e8cc9e55ae799bd1b5431551e537 /gcc/fortran/resolve.c | |
| parent | a73b8b59fb0c47fdf8a31f812867ec56744ec6a4 (diff) | |
| download | gcc-3d333a280ffcb968aa3f561154fde4460ff5e429.zip gcc-3d333a280ffcb968aa3f561154fde4460ff5e429.tar.gz gcc-3d333a280ffcb968aa3f561154fde4460ff5e429.tar.bz2 | |
trans-expr.c (gfc_conv_procedure_call): Fix handling of polymorphic arguments.
2012-07-19 Tobias Burnus <burnus@net-b.de>
* trans-expr.c (gfc_conv_procedure_call): Fix handling
of polymorphic arguments.
* resolve.c (resolve_formal_arglist): Ditto, mark polymorphic
assumed-shape arrays as such.
From-SVN: r189678
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 27 |
1 files changed, 19 insertions, 8 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 73a9731..753f1c7 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -251,6 +251,7 @@ resolve_formal_arglist (gfc_symbol *proc) for (f = proc->formal; f; f = f->next) { sym = f->sym; + gfc_array_spec *as; if (sym == NULL) { @@ -284,23 +285,33 @@ resolve_formal_arglist (gfc_symbol *proc) gfc_set_default_type (sym, 1, sym->ns); } - gfc_resolve_array_spec (sym->as, 0); + as = sym->ts.type == BT_CLASS && sym->attr.class_ok + ? CLASS_DATA (sym)->as : sym->as; + + gfc_resolve_array_spec (as, 0); /* We can't tell if an array with dimension (:) is assumed or deferred shape until we know if it has the pointer or allocatable attributes. */ - if (sym->as && sym->as->rank > 0 && sym->as->type == AS_DEFERRED - && !(sym->attr.pointer || sym->attr.allocatable) + if (as && as->rank > 0 && as->type == AS_DEFERRED + && ((sym->ts.type != BT_CLASS + && !(sym->attr.pointer || sym->attr.allocatable)) + || (sym->ts.type == BT_CLASS + && !(CLASS_DATA (sym)->attr.class_pointer + || CLASS_DATA (sym)->attr.allocatable))) && sym->attr.flavor != FL_PROCEDURE) { - sym->as->type = AS_ASSUMED_SHAPE; - for (i = 0; i < sym->as->rank; i++) - sym->as->lower[i] = gfc_get_int_expr (gfc_default_integer_kind, - NULL, 1); + as->type = AS_ASSUMED_SHAPE; + for (i = 0; i < as->rank; i++) + as->lower[i] = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1); } - if ((sym->as && sym->as->rank > 0 && sym->as->type == AS_ASSUMED_SHAPE) + if ((as && as->rank > 0 && as->type == AS_ASSUMED_SHAPE) || sym->attr.pointer || sym->attr.allocatable || sym->attr.target + || (sym->ts.type == BT_CLASS && sym->attr.class_ok + && (CLASS_DATA (sym)->attr.class_pointer + || CLASS_DATA (sym)->attr.allocatable + || CLASS_DATA (sym)->attr.target)) || sym->attr.optional) { proc->attr.always_explicit = 1; |