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

re PR fortran/40882 ([F03] infinite recursion in gfc_get_derived_type with PPC returning derived type)

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

gcc/fortran/ChangeLog

+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

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)

gcc/testsuite/ChangeLog

+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.

gcc/testsuite/gfortran.dg/proc_ptr_comp_13.f90

+! { 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
+