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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c91ffc9..2cd5dcf 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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..24b0e7b 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 108c040..79258c8 100644 (file)
--- 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 (file)
--- 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" }