diff options
| author | Janus Weil <janus@gcc.gnu.org> | 2018-08-22 19:10:00 +0200 |
|---|---|---|
| committer | Janus Weil <janus@gcc.gnu.org> | 2018-08-22 19:10:00 +0200 |
| commit | 00cad178a359da70204fe1ef4072f3bdbccb799c (patch) | |
| tree | f646b8c67f7b4755ed8483f32f8217ae818b106b /gcc/fortran/resolve.c | |
| parent | b56b07639b1bd36383a0763ba80260c4858160ed (diff) | |
| download | gcc-00cad178a359da70204fe1ef4072f3bdbccb799c.zip gcc-00cad178a359da70204fe1ef4072f3bdbccb799c.tar.gz gcc-00cad178a359da70204fe1ef4072f3bdbccb799c.tar.bz2 | |
re PR fortran/86888 ([F08] allocatable components of indirectly recursive type)
fix PR 86888
2018-08-22 Janus Weil <janus@gcc.gnu.org>
PR fortran/86888
* decl.c (gfc_match_data_decl): Allow allocatable components of
indirectly recursive type.
* resolve.c (resolve_component): Remove two errors messages ...
(resolve_fl_derived): ... and replace them by a new one.
2018-08-22 Janus Weil <janus@gcc.gnu.org>
PR fortran/86888
* gfortran.dg/alloc_comp_basics_6.f90: Update an error message and add
an additional case.
* gfortran.dg/alloc_comp_basics_7.f90: New test case.
* gfortran.dg/class_17.f03: Update error message.
* gfortran.dg/class_55.f90: Ditto.
* gfortran.dg/dtio_11.f90: Update error messages.
* gfortran.dg/implicit_actual.f90: Add an error message.
* gfortran.dg/typebound_proc_12.f90: Update error message.
From-SVN: r263782
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 29 |
1 files changed, 7 insertions, 22 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index d65118d..4ad4dcf 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -14001,28 +14001,6 @@ resolve_component (gfc_component *c, gfc_symbol *sym) CLASS_DATA (c)->ts.u.derived = gfc_find_dt_in_generic (CLASS_DATA (c)->ts.u.derived); - if (!sym->attr.is_class && c->ts.type == BT_DERIVED && !sym->attr.vtype - && c->attr.pointer && c->ts.u.derived->components == NULL - && !c->ts.u.derived->attr.zero_comp) - { - gfc_error ("The pointer component %qs of %qs at %L is a type " - "that has not been declared", c->name, sym->name, - &c->loc); - return false; - } - - if (c->ts.type == BT_CLASS && c->attr.class_ok - && CLASS_DATA (c)->attr.class_pointer - && CLASS_DATA (c)->ts.u.derived->components == NULL - && !CLASS_DATA (c)->ts.u.derived->attr.zero_comp - && !UNLIMITED_POLY (c)) - { - gfc_error ("The pointer component %qs of %qs at %L is a type " - "that has not been declared", c->name, sym->name, - &c->loc); - return false; - } - /* If an allocatable component derived type is of the same type as the enclosing derived type, we need a vtable generating so that the __deallocate procedure is created. */ @@ -14258,6 +14236,13 @@ resolve_fl_derived (gfc_symbol *sym) &sym->declared_at)) return false; + if (sym->components == NULL && !sym->attr.zero_comp) + { + gfc_error ("Derived type %qs at %L has not been declared", + sym->name, &sym->declared_at); + return false; + } + /* Resolve the finalizer procedures. */ if (!gfc_resolve_finalizers (sym, NULL)) return false; |