2009-11-18 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-18  Janus Weil  <janus@gcc.gnu.org>

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

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@154292 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index bfdee68..e1f72a1 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2009-11-18  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-18  Alexandre Oliva  <aoliva@redhat.com>
 
        * module.c (mio_f2k_derived): Initialize op.

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 5a45f4f..b72d540 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2640,13 +2640,16 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
          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 (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));
+         
+         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));
 
          return 0;
        }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 0196182..594210f 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2009-11-18  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/42072
+       * gfortran.dg/proc_ptr_8.f90: Extended.
+
 2009-11-18  Shujing Zhao  <pearly.zhao@oracle.com>
 
        * g++.old-deja/g++.other/crash28.C: Make expected dg-error strings

diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_8.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_8.f90
index 80d2661..f45d114 100644 (file)
--- a/gcc/testsuite/gfortran.dg/proc_ptr_8.f90
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_8.f90
@@ -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" } }