Re: [Patch, Fortran, F03] PR 40870: include formal args in backend_decl of PPCs

[Paul Richard Thomas <paul dot richard dot thomas at gmail dot com>]

Aahhh!  That's because it's so good that it's invisible.  For lesser
mortals that can't deal with the latest technology, please find the
diff attached.

Cheers

Paul

On Tue, Aug 4, 2009 at 3:17 PM, Janus Weil<janus@gcc.gnu.org> wrote:
> 2009/8/4 Paul Richard Thomas <paul.richard.thomas@gmail.com>:
>>> Well, in principle you're right: Usually one should test for
>>> TYPE_FIELDS. However, in this case I think it's not possible, because
>>> the fields have not been built yet. Here's an example:
>>
>> Indeed! ?That was the idea behind the modified patch that I attached.
>
> Sorry, I think the attachment was missing?!?
>
> Cheers,
> Janus
>



-- 
The knack of flying is learning how to throw yourself at the ground and miss.
       --Hitchhikers Guide to the Galaxy

Index: gcc/fortran/trans-types.c
===================================================================
--- gcc/fortran/trans-types.c	(revision 150371)
+++ gcc/fortran/trans-types.c	(working copy)
@@ -1895,16 +1895,14 @@
 gfc_get_ppc_type (gfc_component* c)
 {
   tree t;
+
+  if (c->ts.interface)
+    return build_pointer_type (gfc_get_function_type (c->ts.interface));
+
   if (c->attr.function && !c->attr.dimension)
-    {
-      if (c->ts.type == BT_DERIVED)
-	t = c->ts.derived->backend_decl;
-      else
-	t = gfc_typenode_for_spec (&c->ts);
-    }
+    t = gfc_typenode_for_spec (&c->ts);
   else
     t = void_type_node;
-  /* TODO: Build argument list.  */
   return build_pointer_type (build_function_type (t, NULL_TREE));
 }
 
@@ -2012,8 +2010,11 @@
      components' backend_decl may have not been built.  */
   if (derived->backend_decl)
     {
-      /* Its components' backend_decl have been built.  */
-      if (TYPE_FIELDS (derived->backend_decl))
+      /* 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)
         return derived->backend_decl;
       else
         typenode = derived->backend_decl;
Index: gcc/testsuite/gfortran.dg/proc_ptr_comp_13.f90
===================================================================
--- gcc/testsuite/gfortran.dg/proc_ptr_comp_13.f90	(revision 150371)
+++ gcc/testsuite/gfortran.dg/proc_ptr_comp_13.f90	(working copy)
@@ -1,6 +1,7 @@
 ! { dg-do run }
 !
-! PR 40882: [F03] infinite recursion in gfc_get_derived_type with PPC returning derived type
+! PR 40882: [F03] infinite recursion in gfc_get_derived_type with PPC returning derived type.
+! At the same time, check that a formal argument does not cause infinite recursion.
 !
 ! Contributed by Janus Weil <janus@gcc.gnu.org>
 
@@ -16,7 +17,7 @@
 o%data = 1
 o%ppc => foo
 
-o2 = o%ppc()
+o2 = o%ppc(o)
 
 if (o%data /= 1) call abort()
 if (o2%data /= 5) call abort()
@@ -25,9 +26,9 @@
 
 contains
 
-  function foo()
-    type(t) :: foo
-    foo%data = 5
+  function foo(arg)
+    type(t) :: foo, arg
+    foo%data = arg%data * 5
     foo%ppc => NULL()
   end function