From 827c5be4f719bbd9cbee6d27baaa4276b80e9c1d Mon Sep 17 00:00:00 2001
From: Janus Weil <janus@gcc.gnu.org>
Date: Wed, 18 Nov 2009 14:24:54 +0100
Subject: [PATCH] re PR fortran/42072 ([F03] wrong-code with C_F_PROCPOINTER)
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.
From-SVN: r154292
---
gcc/fortran/ChangeLog | 6 ++++++
gcc/fortran/trans-expr.c | 17 ++++++++++-------
gcc/testsuite/ChangeLog | 5 +++++
gcc/testsuite/gfortran.dg/proc_ptr_8.f90 | 13 ++++++++++++-
4 files changed, 33 insertions(+), 8 deletions(-)
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index bfdee68f0d34..e1f72a12f98d 100644
--- 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 5a45f4f6368b..b72d5401bae2 100644
--- 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 01961823f9e4..594210fe335a 100644
--- 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 80d26619bc01..f45d114f8336 100644
--- 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" } }
--
GitLab