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

2014-03-19  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-19  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: r221523

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 51e5b8ccaf2616db3b316b2ef8f6deba9b67cc82..f762bb93cacfb1028b5bf2ddc723af50acf9c399 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2014-03-19  Paul Thomas  <pault@gcc.gnu.org>
+
+       Backport from mainline
+       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-12  Mikael Morin  <mikael@gcc.gnu.org>
 
        PR fortran/60898

diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 22f456e02838b9119df6dd2b33f89cde96f14a56..20069e239ccc088a13371b565274b2295c39d297 100644 (file)
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -2415,9 +2415,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 7f79d7dc4b3aa1c1d8bd1e299c853d1dc19ab755..31de6375b9c9b8d0fa937f7fb3b7776f763eed21 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2014-03-19  Paul Thomas  <pault@gcc.gnu.org>
+
+       Backport from mainline
+       PR fortran/59198
+       * gfortran.dg/proc_ptr_comp_44.f90 : New test
+       * gfortran.dg/proc_ptr_comp_45.f90 : New test
+
 2015-03-19  Kyrylo Tkachov  <kyrylo.tkachov@arm.com>
 
        Backport from mainline

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..3180345
--- /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 (abs (template%obs1_int (arg) - cos (arg)) .gt. 1e-4) call abort
+  allocate (object, source = template)
+  if (abs (object%obs1_int (arg) - cos (arg)) .gt. 1e-4) call abort
+end