[Patch, Fortran] PR 42072: [F03] wrong-code with C_F_PROCPOINTER

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

Hi all,

the attached patch fixes the behavior of C_F_PROCPOINTER if its
procptr argument is itself a dummy argument of another procedure. For
this case I added an additional 'build_fold_indirect_ref_loc', and I
also removed an unneeded 'tmp' variable. The patch was regtested on
x86_64-unknown-linux-gnu with no failures. Ok for trunk?

Two side-notes:

1) About the wrong static decl (cf. comments #3 and #5): I currently
have no idea how this comes about, and why the static prototype is
different from the actual declaration of the function. Does anyone
have an idea?

2) Once again I stumbled over the fact that the ISO_C_BINDING
intrinsics are handled in gfc_conv_procedure_call, in contrast to all
the other intrinsics, which are translated in trans-intrinsic.c. It
seems to me that gfc_conv_procedure_call is not a particularly good
place for this, as it is already a *huge* routine (several hundred
lines), even without the additional clobbering due to these
intrinsics. Is there a special reason that this is done in this very
place, or should we rather move this code to trans-intrinsic.c? (If
the latter, I would open a cleanup PR for this.)

Cheers,
Janus


2009-11-17  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/42072
	* trans-expr.c (gfc_conv_procedure_call): Handle procedure pointer
	dummies which are passed to C_F_PROCPOINTER.


2009-11-17  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/42072
	* gfortran.dg/proc_ptr_8.f90: Extended.

Index: gcc/testsuite/gfortran.dg/proc_ptr_8.f90
===================================================================
--- gcc/testsuite/gfortran.dg/proc_ptr_8.f90	(revision 154242)
+++ gcc/testsuite/gfortran.dg/proc_ptr_8.f90	(working copy)
@@ -23,12 +23,23 @@ MODULE X
 END MODULE X
 
 USE X
-PROCEDURE(mytype), POINTER :: ptype
+PROCEDURE(mytype), POINTER :: ptype,ptype2
 
 CALL init()
 CALL C_F_PROCPOINTER(funpointer,ptype)
 if (ptype(3) /= 9) call abort()
 
+! the stuff below was added with PR 42072
+call setpointer(ptype2)
+if (ptype2(4) /= 12) call abort()
+
+contains
+
+  subroutine setpointer (p)
+    PROCEDURE(mytype), POINTER :: p
+    CALL C_F_PROCPOINTER(funpointer,p)
+  end subroutine
+
 END
 
 ! { dg-final { cleanup-modules "X" } }
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(revision 154242)
+++ gcc/fortran/trans-expr.c	(working copy)
@@ -2640,14 +2640,17 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol *
 	  gfc_conv_expr (&fptrse, arg->next->expr);
 	  gfc_add_block_to_block (&se->pre, &fptrse.pre);
 	  gfc_add_block_to_block (&se->post, &fptrse.post);
+	  
+	  if (arg->next->expr->symtree->n.sym->attr.proc_pointer
+	      && arg->next->expr->symtree->n.sym->attr.dummy)
+	    fptrse.expr = build_fold_indirect_ref_loc (input_location,
+						       fptrse.expr);
+	  
+	  se->expr = fold_build2 (MODIFY_EXPR, TREE_TYPE (fptrse.expr),
+				  fptrse.expr,
+				  fold_convert (TREE_TYPE (fptrse.expr),
+						cptrse.expr));
 
-	  if (gfc_is_proc_ptr_comp (arg->next->expr, NULL))
-	    tmp = gfc_get_ppc_type (arg->next->expr->ref->u.c.component);
-	  else
-	    tmp = TREE_TYPE (arg->next->expr->symtree->n.sym->backend_decl);
-	  se->expr = fold_build2 (MODIFY_EXPR, tmp, fptrse.expr,
-				  fold_convert (tmp, cptrse.expr));
-
 	  return 0;
 	}
       else if (sym->intmod_sym_id == ISOCBINDING_ASSOCIATED)