re PR fortran/40882 ([F03] infinite recursion in gfc_get_derived_type with PPC return...

2009-07-28  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/40882
	* trans-types.c (gfc_get_ppc_type): For derived types, directly use the
	backend_decl, instead of calling gfc_typenode_for_spec, to avoid
	infinte loop.
	(gfc_get_derived_type): Correctly handle PPCs returning derived types,
	avoiding infinite recursion.

2009-07-28  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/40882
	* gfortran.dg/proc_ptr_comp_13.f90: New.

From-SVN: r150154

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7b6d59e0351d03e203d82e502719c1d4336c1f9c..ea622e565bfecb8640a1f3c962d15caa39a27106 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2009-07-28  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/40882
+       * trans-types.c (gfc_get_ppc_type): For derived types, directly use the
+       backend_decl, instead of calling gfc_typenode_for_spec, to avoid
+       infinte loop.
+       (gfc_get_derived_type): Correctly handle PPCs returning derived types,
+       avoiding infinite recursion.
+
 2009-07-27  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/40848

diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 99967ce3705fb4a54a6c73ee9b218f87fbd4bdcf..77b8b9c66069ed3dda7bc9a84a3f4001240397ae 100644 (file)
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1894,7 +1894,12 @@ gfc_get_ppc_type (gfc_component* c)
 {
   tree t;
   if (c->attr.function && !c->attr.dimension)
-    t = gfc_typenode_for_spec (&c->ts);
+    {
+      if (c->ts.type == BT_DERIVED)
+       t = c->ts.derived->backend_decl;
+      else
+       t = gfc_typenode_for_spec (&c->ts);
+    }
   else
     t = void_type_node;
   /* TODO: Build argument list.  */
@@ -1974,7 +1979,8 @@ gfc_get_derived_type (gfc_symbol * derived)
       if (c->ts.type != BT_DERIVED)
        continue;
 
-      if (!c->attr.pointer || c->ts.derived->backend_decl == NULL)
+      if ((!c->attr.pointer && !c->attr.proc_pointer)
+         || c->ts.derived->backend_decl == NULL)
        c->ts.derived->backend_decl = gfc_get_derived_type (c->ts.derived);
 
       if (c->ts.derived && c->ts.derived->attr.is_iso_c)
@@ -2003,10 +2009,10 @@ gfc_get_derived_type (gfc_symbol * derived)
   fieldlist = NULL_TREE;
   for (c = derived->components; c; c = c->next)
     {
-      if (c->ts.type == BT_DERIVED)
-        field_type = c->ts.derived->backend_decl;
-      else if (c->attr.proc_pointer)
+      if (c->attr.proc_pointer)
        field_type = gfc_get_ppc_type (c);
+      else if (c->ts.type == BT_DERIVED)
+        field_type = c->ts.derived->backend_decl;
       else
        {
          if (c->ts.type == BT_CHARACTER)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 086d6f9d48189b76866a1503e093abdfb447bd20..85f780b83a7ad3427f5c1b862ec9f08db94672ef 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2009-07-28  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/40882
+       * gfortran.dg/proc_ptr_comp_13.f90: New.
+
 2009-07-28  Jan Beulich  <jbeulich@novell.com>
 
        * gcc.target/i386/avx-vtestpd-1.c: Add -DNEED_IEEE754_DOUBLE.

diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_13.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_13.f90
new file mode 100644 (file)
index 0000000..45ffa1e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_13.f90
@@ -0,0 +1,35 @@
+! { dg-do run }
+!
+! PR 40882: [F03] infinite recursion in gfc_get_derived_type with PPC returning derived type
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+implicit none
+
+type :: t
+  integer :: data
+  procedure(foo), pointer, nopass :: ppc
+end type
+
+type(t) :: o,o2
+
+o%data = 1
+o%ppc => foo
+
+o2 = o%ppc()
+
+if (o%data /= 1) call abort()
+if (o2%data /= 5) call abort()
+if (.not. associated(o%ppc)) call abort()
+if (associated(o2%ppc)) call abort()
+
+contains
+
+  function foo()
+    type(t) :: foo
+    foo%data = 5
+    foo%ppc => NULL()
+  end function
+
+end
+