Re: [Patch, Fortran] PR 40176: Fortran 2003: Procedure pointers with array return value

[Janus Weil <janus at gcc dot gnu dot org>]

2009/5/21 Janus Weil <janus@gcc.gnu.org>:
> this patch fixes some problems related to procedure pointers with
> array return value, and a small one related to procedure pointer
> assignments with dummy arguments. Note that there are still some
> remaining issues regarding PPCs with array return values (i.e.
> actually calling them does not work yet). This is a bit more
> complicated to fix, since it requires interface re-mapping etc, and I
> will take care of it later. First I want to get these problems with
> 'ordinary' procedure pointers out of the way.

Update: The hunk in resolve.c (resolve_fl_derived) is actually not
needed, and can potentially induce an infinite loop, therefore I
removed it again. It was only added in analogy to the hunk in
resolve_symbol. The test cases still work. Updated patch attachted.



> Reg-tested on x86_64-unknown-linux-gnu. Ok for trunk?
>
> Cheers,
> Janus
>
>
> 2009-05-21 ?Janus Weil ?<janus@gcc.gnu.org>
>
> ? ? ? ?PR fortran/40176
> ? ? ? ?* resolve.c (resolve_fl_derived): Make sure the interface of a
> ? ? ? ?procedure pointer component has been resolved.
> ? ? ? ?(resolve_symbol): Make sure the interface of a procedure pointer has
> ? ? ? ?been resolved.
> ? ? ? ?* trans-expr.c (gfc_conv_component_ref): Handle procedure pointer
> ? ? ? ?components with array return value.
> ? ? ? ?(gfc_trans_pointer_assignment): Handle procedure pointer assignments,
> ? ? ? ?where the rhs is a dummy argument.
> ? ? ? ?* trans-types.c (gfc_get_ppc_type,gfc_get_derived_type): Handle
> ? ? ? ?procedure pointer components with array return value.
>
>
> 2009-05-21 ?Janus Weil ?<janus@gcc.gnu.org>
>
> ? ? ? ?PR fortran/40176
> ? ? ? ?* gfortran.dg/proc_ptr_18.f90: New.
> ? ? ? ?* gfortran.dg/proc_ptr_19.f90: New.
> ? ? ? ?* gfortran.dg/proc_ptr_comp_9.f90: New.
>

Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(revision 147794)
+++ gcc/fortran/trans-expr.c	(working copy)
@@ -476,8 +476,8 @@ gfc_conv_component_ref (gfc_se * se, gfc
       se->string_length = tmp;
     }
 
-  if ((c->attr.pointer || c->attr.proc_pointer) && c->attr.dimension == 0
-      && c->ts.type != BT_CHARACTER)
+  if ((c->attr.pointer && c->attr.dimension == 0 && c->ts.type != BT_CHARACTER)
+      || c->attr.proc_pointer)
     se->expr = build_fold_indirect_ref (se->expr);
 }
 
@@ -4053,6 +4053,10 @@ gfc_trans_pointer_assignment (gfc_expr *
 	  && expr1->symtree->n.sym->attr.dummy)
 	lse.expr = build_fold_indirect_ref (lse.expr);
 
+      if (expr2->symtree && expr2->symtree->n.sym->attr.proc_pointer
+	  && expr2->symtree->n.sym->attr.dummy)
+	rse.expr = build_fold_indirect_ref (rse.expr);
+
       gfc_add_block_to_block (&block, &lse.pre);
       gfc_add_block_to_block (&block, &rse.pre);
 
Index: gcc/fortran/trans-types.c
===================================================================
--- gcc/fortran/trans-types.c	(revision 147794)
+++ gcc/fortran/trans-types.c	(working copy)
@@ -1875,7 +1875,7 @@ tree
 gfc_get_ppc_type (gfc_component* c)
 {
   tree t;
-  if (c->attr.function)
+  if (c->attr.function && !c->attr.dimension)
     t = gfc_typenode_for_spec (&c->ts);
   else
     t = void_type_node;
@@ -1997,7 +1997,7 @@ gfc_get_derived_type (gfc_symbol * deriv
 
       /* This returns an array descriptor type.  Initialization may be
          required.  */
-      if (c->attr.dimension)
+      if (c->attr.dimension && !c->attr.proc_pointer)
 	{
 	  if (c->attr.pointer || c->attr.allocatable)
 	    {
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 147794)
+++ gcc/fortran/resolve.c	(working copy)
@@ -9414,6 +9414,7 @@ resolve_symbol (gfc_symbol *sym)
 	  || sym->ts.interface->attr.intrinsic)
 	{
 	  gfc_symbol *ifc = sym->ts.interface;
+	  resolve_symbol (ifc);
 
 	  if (ifc->attr.intrinsic)
 	    resolve_intrinsic (ifc, &ifc->declared_at);