[Fortran,F08] PR 86888: allocatable components of indirectly recursive type

Message ID CAKwh3qjHFY8-OFVTWJRPXV8-rdX_M=D=Kvdt1h4VMLihCnVWLQ@mail.gmail.com
State New
Headers show
Series
  • [Fortran,F08] PR 86888: allocatable components of indirectly recursive type
Related show

Commit Message

Janus Weil Aug. 21, 2018, 8:48 p.m.
Hi all,

the attached patch fixes the PR in the subject line in a rather
straightforward fashion. Pointer components of indirectly recursive
type are working already, as well as allocatable components of
directly recursive type. It seems this case was simply forgotten.

The patch regtests cleanly on x86_64-linux-gnu. Ok for trunk?

Cheers,
Janus


https://github.com/janusw/gcc/commit/6f5a1b637e562b86d06d9a0d852c18ecb219c5ec

Comments

Paul Richard Thomas Aug. 22, 2018, 1:44 p.m. | #1
Hi Janus,


> the attached patch fixes the PR in the subject line in a rather

> straightforward fashion. Pointer components of indirectly recursive

> type are working already, as well as allocatable components of

> directly recursive type. It seems this case was simply forgotten.


That is correct. I was aware that it had been forgotten and is
somewhere far, far down on my TODO list. Thank you for dealing with
it.

OK for trunk.

Paul




-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
Janus Weil Aug. 22, 2018, 5:12 p.m. | #2
Am Mi., 22. Aug. 2018 um 15:44 Uhr schrieb Paul Richard Thomas
<paul.richard.thomas@gmail.com>:
>

> > the attached patch fixes the PR in the subject line in a rather

> > straightforward fashion. Pointer components of indirectly recursive

> > type are working already, as well as allocatable components of

> > directly recursive type. It seems this case was simply forgotten.

>

> That is correct. I was aware that it had been forgotten and is

> somewhere far, far down on my TODO list. Thank you for dealing with

> it.


Thanks, Paul. Committed as r263782.

Cheers,
Janus

Patch

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index dc4aa1acf74..03e8b137e8f 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@ 
+2018-08-21  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-16  Nathan Sidwell  <nathan@acm.org>
 
 	* cpp.c (dump_macro): Use cpp_user_macro_p.
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 1384bc717d8..03298833c98 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 d65118dfae3..4ad4dcf780d 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 6c87f8017d3..5de896bdf37 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,15 @@ 
+2018-08-21  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-21  Marek Polacek  <polacek@redhat.com>
 
 	PR c++/86981, Implement -Wpessimizing-move.
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_basics_6.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_basics_6.f90
index 3ed221db24f..4eb0e49a7e5 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 00000000000..72296302169
--- /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 0c5c23884d9..24b0e7b61f3 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 b47989f416c..e6296982536 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 1f148c3b896..cf939328139 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 108c0407967..79258c88b87 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 4612d4982f3..ea43dab8767 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" }