re PR fortran/59198 (ICE on cyclically dependent polymorphic types)

2014-03-17  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/59198
	* trans-types.c (gfc_get_derived_type): If an abstract derived
	type with procedure pointer components has no other type of
	component, return the backend_decl. Otherwise build the
	components if any of the non-procedure pointer components have
	no backend_decl.

2014-03-17  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/59198
	* gfortran.dg/proc_ptr_comp_44.f90 : New test
	* gfortran.dg/proc_ptr_comp_45.f90 : New test

From-SVN: r221474

5 files changed, 152 insertions, 2 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b638835..21a3b35 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2014-03-17  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/59198
+	* trans-types.c (gfc_get_derived_type): If an abstract derived
+	type with procedure pointer components has no other type of
+	component, return the backend_decl. Otherwise build the
+	components if any of the non-procedure pointer components have
+	no backend_decl.
+
 2015-03-16  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR fortran/64432
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 53da053..708289f 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -2448,9 +2448,24 @@ gfc_get_derived_type (gfc_symbol * derived)
       /* Its components' backend_decl have been built or we are
 	 seeing recursion through the formal arglist of a procedure
 	 pointer component.  */
-      if (TYPE_FIELDS (derived->backend_decl)
-	    || derived->attr.proc_pointer_comp)
+      if (TYPE_FIELDS (derived->backend_decl))
         return derived->backend_decl;
+      else if (derived->attr.abstract
+	       && derived->attr.proc_pointer_comp)
+	{
+	  /* If an abstract derived type with procedure pointer
+	     components has no other type of component, return the
+	     backend_decl. Otherwise build the components if any of the
+	     non-procedure pointer components have no backend_decl.  */
+	  for (c = derived->components; c; c = c->next)
+	    {
+	      if (!c->attr.proc_pointer && c->backend_decl == NULL)
+		break;
+	      else if (c->next == NULL)
+		return derived->backend_decl;
+	    }
+	  typenode = derived->backend_decl;
+	}
       else
         typenode = derived->backend_decl;
     }
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3e6beb2..12324f0 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2014-03-17  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/59198
+	* gfortran.dg/proc_ptr_comp_44.f90 : New test
+	* gfortran.dg/proc_ptr_comp_45.f90 : New test
+
 2015-03-16 Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR fortran/64432
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_44.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_44.f90
new file mode 100644
index 0000000..15795c2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_44.f90
@@ -0,0 +1,71 @@
+! { dg-do compile }
+! Test the fix for PR59198, where the field for the component 'term' in
+! the derived type 'decay_gen_t' was not being built.
+!
+! Contributed by Juergen Reuter  <juergen.reuter@desy.de>
+!
+module decays
+  abstract interface
+     function obs_unary_int ()
+     end function obs_unary_int
+  end interface
+
+  type, abstract :: any_config_t
+   contains
+     procedure (any_config_final), deferred :: final
+  end type any_config_t
+
+  type :: decay_term_t
+     type(unstable_t), dimension(:), pointer :: unstable_product => null ()
+  end type decay_term_t
+
+  type, abstract :: decay_gen_t
+     type(decay_term_t), dimension(:), allocatable :: term
+     procedure(obs_unary_int),   nopass, pointer :: obs1_int  => null ()
+  end type decay_gen_t
+
+  type, extends (decay_gen_t) :: decay_root_t
+   contains
+     procedure :: final => decay_root_final
+  end type decay_root_t
+
+  type, abstract :: rng_t
+  end type rng_t
+
+  type, extends (decay_gen_t) :: decay_t
+     class(rng_t), allocatable :: rng
+   contains
+     procedure :: final => decay_final
+  end type decay_t
+
+  type, extends (any_config_t) :: unstable_config_t
+   contains
+     procedure :: final => unstable_config_final
+  end type unstable_config_t
+
+  type :: unstable_t
+     type(unstable_config_t), pointer :: config => null ()
+     type(decay_t), dimension(:), allocatable :: decay
+  end type unstable_t
+
+  interface
+     subroutine any_config_final (object)
+       import
+       class(any_config_t), intent(inout) :: object
+     end subroutine any_config_final
+  end interface
+
+contains
+  subroutine decay_root_final (object)
+    class(decay_root_t), intent(inout) :: object
+  end subroutine decay_root_final
+
+  recursive subroutine decay_final (object)
+    class(decay_t), intent(inout) :: object
+  end subroutine decay_final
+
+  recursive subroutine unstable_config_final (object)
+    class(unstable_config_t), intent(inout) :: object
+  end subroutine unstable_config_final
+
+end module decays
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_45.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_45.f90
new file mode 100644
index 0000000..8f8a8fe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_45.f90
@@ -0,0 +1,49 @@
+! { dg-do run }
+! Test the fix for PR59198, where the field for the component 'term' in
+! the derived type 'decay_gen_t' was not being built.
+!
+! Contributed by Paul Thomas and based on the original testcase by
+! Juergen Reuter  <juergen.reuter@desy.de>
+!
+module decays
+
+  implicit none
+
+  interface
+    real elemental function iface (arg)
+      real, intent(in) :: arg
+    end function
+  end interface
+
+  type :: decay_term_t
+     type(decay_t), pointer :: unstable_product
+     integer :: i
+  end type
+
+  type :: decay_gen_t
+     procedure(iface), nopass, pointer :: obs1_int
+     type(decay_term_t), allocatable :: term
+  end type
+
+  type :: rng_t
+    integer :: i
+  end type
+
+  type, extends (decay_gen_t) :: decay_t
+     class(rng_t), allocatable :: rng
+  end type
+
+  class(decay_t), allocatable :: object
+
+end
+
+  use decays
+  type(decay_t), pointer :: template
+  real, parameter :: arg = 1.570796327
+  allocate (template)
+  allocate (template%rng)
+  template%obs1_int => cos
+  if (template%obs1_int (arg) .ne. cos (arg)) call abort
+  allocate (object, source = template)
+  if (object%obs1_int (arg) .ne. cos (arg)) call abort
+end