diff options
| author | Janus Weil <janus@gcc.gnu.org> | 2010-05-17 10:25:06 +0200 |
|---|---|---|
| committer | Janus Weil <janus@gcc.gnu.org> | 2010-05-17 10:25:06 +0200 |
| commit | 233961db333a77cac359e6c35eae5565703d7d78 (patch) | |
| tree | cc125ce7c9d586b49292aa69c4db298e3ae2b543 /gcc/fortran/resolve.c | |
| parent | ff71b48db05886b0e676598173eb133ac7ba07f1 (diff) | |
| download | gcc-233961db333a77cac359e6c35eae5565703d7d78.zip gcc-233961db333a77cac359e6c35eae5565703d7d78.tar.gz gcc-233961db333a77cac359e6c35eae5565703d7d78.tar.bz2 | |
re PR fortran/44044 ([OOP] SELECT TYPE with class-valued function)
2010-05-17 Janus Weil <janus@gcc.gnu.org>
PR fortran/44044
* resolve.c (resolve_fl_var_and_proc): Move error messages here from ...
(resolve_fl_variable_derived): ... this place.
(resolve_symbol): Make sure function symbols (and their result
variables) are not resolved twice.
2010-05-17 Janus Weil <janus@gcc.gnu.org>
PR fortran/44044
* gfortran.dg/class_20.f03: New.
From-SVN: r159476
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 48 |
1 files changed, 27 insertions, 21 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index da8d896..d165bd6 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -9143,6 +9143,29 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag) return FAILURE; } } + + /* Constraints on polymorphic variables. */ + if (sym->ts.type == BT_CLASS && !(sym->result && sym->result != sym)) + { + /* F03:C502. */ + if (!gfc_type_is_extensible (sym->ts.u.derived->components->ts.u.derived)) + { + gfc_error ("Type '%s' of CLASS variable '%s' at %L is not extensible", + sym->ts.u.derived->components->ts.u.derived->name, + sym->name, &sym->declared_at); + return FAILURE; + } + + /* F03:C509. */ + /* Assume that use associated symbols were checked in the module ns. */ + if (!sym->attr.class_ok && !sym->attr.use_assoc) + { + gfc_error ("CLASS variable '%s' at %L must be dummy, allocatable " + "or pointer", sym->name, &sym->declared_at); + return FAILURE; + } + } + return SUCCESS; } @@ -9194,27 +9217,6 @@ resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag) &sym->declared_at) == FAILURE) return FAILURE; - if (sym->ts.type == BT_CLASS) - { - /* C502. */ - if (!gfc_type_is_extensible (sym->ts.u.derived->components->ts.u.derived)) - { - gfc_error ("Type '%s' of CLASS variable '%s' at %L is not extensible", - sym->ts.u.derived->components->ts.u.derived->name, - sym->name, &sym->declared_at); - return FAILURE; - } - - /* C509. */ - /* Assume that use associated symbols were checked in the module ns. */ - if (!sym->attr.class_ok && !sym->attr.use_assoc) - { - gfc_error ("CLASS variable '%s' at %L must be dummy, allocatable " - "or pointer", sym->name, &sym->declared_at); - return FAILURE; - } - } - /* Assign default initializer. */ if (!(sym->value || sym->attr.pointer || sym->attr.allocatable) && (!no_init_flag || sym->attr.intent == INTENT_OUT)) @@ -11130,6 +11132,10 @@ resolve_symbol (gfc_symbol *sym) gfc_namespace *ns; gfc_component *c; + /* Avoid double resolution of function result symbols. */ + if ((sym->result || sym->attr.result) && (sym->ns != gfc_current_ns)) + return; + if (sym->attr.flavor == FL_UNKNOWN) { |