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 | |
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
-rw-r--r-- | gcc/fortran/ChangeLog | 8 | ||||
-rw-r--r-- | gcc/fortran/decl.c | 3 | ||||
-rw-r--r-- | gcc/fortran/resolve.c | 29 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 12 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/alloc_comp_basics_6.f90 | 3 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/alloc_comp_basics_7.f90 | 15 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/class_17.f03 | 2 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/class_55.f90 | 2 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/dtio_11.f90 | 6 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/implicit_actual.f90 | 2 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/typebound_proc_12.f90 | 2 |
11 files changed, 52 insertions, 32 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c91ffc9..2cd5dcf 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +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-21 Janne Blomqvist <jb@gcc.gnu.org> * trans-intrinsic.c (gfc_conv_intrinsic_minmax): Use diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 1384bc7..0329883 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -5864,8 +5864,7 @@ gfc_match_data_decl (void) if (current_attr.pointer && gfc_comp_struct (gfc_current_state ())) goto ok; - if (current_attr.allocatable && gfc_current_state () == COMP_DERIVED - && current_ts.u.derived == gfc_current_block ()) + if (current_attr.allocatable && gfc_current_state () == COMP_DERIVED) goto ok; gfc_find_symbol (current_ts.u.derived->name, 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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 42f10ae..59a9038 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,15 @@ +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. + 2018-08-22 Martin Sebor <msebor@redhat.com> PR middle-end/87052 diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_basics_6.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_basics_6.f90 index 3ed221d..4eb0e49 100644 --- a/gcc/testsuite/gfortran.dg/alloc_comp_basics_6.f90 +++ b/gcc/testsuite/gfortran.dg/alloc_comp_basics_6.f90 @@ -5,7 +5,8 @@ ! Contributed by Joost VandeVondele <Joost.VandeVondele@mat.ethz.ch> type sysmtx_t - type(ext_complex_t), allocatable :: S(:) ! { dg-error "has not been previously defined" } + type(ext_complex_t), allocatable :: S(:) ! { dg-error "has not been declared" } + class(some_type), allocatable :: X ! { dg-error "has not been declared" } end type end diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_basics_7.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_basics_7.f90 new file mode 100644 index 0000000..7229630 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_basics_7.f90 @@ -0,0 +1,15 @@ +! { dg-do compile } +! +! PR 86888: [F08] allocatable components of indirectly recursive type +! +! Contributed by Janus Weil <janus@gcc.gnu.org> + +type :: s + type(t), allocatable :: x +end type + +type :: t + type(s), allocatable :: y +end type + +end diff --git a/gcc/testsuite/gfortran.dg/class_17.f03 b/gcc/testsuite/gfortran.dg/class_17.f03 index 0c5c238..24b0e7b6 100644 --- a/gcc/testsuite/gfortran.dg/class_17.f03 +++ b/gcc/testsuite/gfortran.dg/class_17.f03 @@ -56,7 +56,7 @@ end MODULE error_stack_module module b_module implicit none type::b_type - class(not_yet_defined_type_type),pointer::b_component ! { dg-error "is a type that has not been declared" } + class(not_yet_defined_type_type),pointer::b_component ! { dg-error "has not been declared" } end type b_type end module b_module diff --git a/gcc/testsuite/gfortran.dg/class_55.f90 b/gcc/testsuite/gfortran.dg/class_55.f90 index b47989f..e629698 100644 --- a/gcc/testsuite/gfortran.dg/class_55.f90 +++ b/gcc/testsuite/gfortran.dg/class_55.f90 @@ -5,7 +5,7 @@ ! Contributed by Sylwester Arabas <slayoo@staszic.waw.pl> type :: mpdata_t - class(bcd_t), pointer :: bcx, bcy ! { dg-error "is a type that has not been declared" } + class(bcd_t), pointer :: bcx, bcy ! { dg-error "has not been declared" } end type type(mpdata_t) :: this call this%bcx%fill_halos() ! { dg-error "is being used before it is defined" } diff --git a/gcc/testsuite/gfortran.dg/dtio_11.f90 b/gcc/testsuite/gfortran.dg/dtio_11.f90 index 1f148c3..cf93932 100644 --- a/gcc/testsuite/gfortran.dg/dtio_11.f90 +++ b/gcc/testsuite/gfortran.dg/dtio_11.f90 @@ -15,13 +15,13 @@ end ! PR77533 - used to ICE after error module m2 type t - type(unknown), pointer :: next ! { dg-error "is a type that has not been declared" } + type(unknown), pointer :: next ! { dg-error "has not been declared" } contains - procedure :: s + procedure :: s ! { dg-error "Non-polymorphic passed-object" } generic :: write(formatted) => s end type contains - subroutine s(x) + subroutine s(x) ! { dg-error "Too few dummy arguments" } end end diff --git a/gcc/testsuite/gfortran.dg/implicit_actual.f90 b/gcc/testsuite/gfortran.dg/implicit_actual.f90 index 108c0407..79258c8 100644 --- a/gcc/testsuite/gfortran.dg/implicit_actual.f90 +++ b/gcc/testsuite/gfortran.dg/implicit_actual.f90 @@ -14,7 +14,7 @@ end module global program snafu ! use global - implicit type (t3) (z) + implicit type (t3) (z) ! { dg-error "has not been declared" } call foo (zin) ! { dg-error "defined|Type mismatch" } diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_12.f90 b/gcc/testsuite/gfortran.dg/typebound_proc_12.f90 index 4612d49..ea43dab 100644 --- a/gcc/testsuite/gfortran.dg/typebound_proc_12.f90 +++ b/gcc/testsuite/gfortran.dg/typebound_proc_12.f90 @@ -5,7 +5,7 @@ ! Contributed by Joost VandeVondele <jv244@cam.ac.uk> ! TYPE a - TYPE(b), DIMENSION(:), POINTER :: c ! { dg-error "type that has not been declared" } + TYPE(b), DIMENSION(:), POINTER :: c ! { dg-error "has not been declared" } END TYPE TYPE(a), POINTER :: d CALL X(d%c%e) ! { dg-error "before it is defined" } |