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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b638835c9beb315b8b21fd6f37e085fe47daabc9..21a3b35e9a894004c4e18ee5ab1a2de8d89f33f6 100644 (file)
--- 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 53da053fc4dba80bbf8d7dd2611fc16cc23fee55..708289f064faa857355f8a204d9e596128f15c0a 100644 (file)
--- 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 3e6beb2c7e2e01dfb853763b136b89d3d1bb289b..12324f0e4940f3efd9adba2b1dd867f084e8afb5 100644 (file)
--- 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 (file)
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 (file)
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