A rather obvious patch: With proc-pointer dummies, one compared the
address of the pointer and not of the pointer target.
Build and regtested on x86-64-linux.
OK for the trunk? (What's the sentiment regarding backporting to 4.7.1?)
Tobias
PS: The patch looks larger than it is: I converted some spaces into tabs.
2012-03-15 Tobias Burnus <bur...@net-b.de>
PR fortran/52585
* trans-intrinsic.c (gfc_conv_associated): Fix handling of
procpointer dummy arguments.
2012-03-15 Tobias Burnus <bur...@net-b.de>
PR fortran/52585
* gfortran.dg/proc_ptr_36.f90: New.
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index ac9f507..2ec97c2 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -5761,10 +5787,14 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
/* No optional target. */
if (ss1 == gfc_ss_terminator)
{
- /* A pointer to a scalar. */
- arg1se.want_pointer = 1;
- gfc_conv_expr (&arg1se, arg1->expr);
- tmp2 = arg1se.expr;
+ /* A pointer to a scalar. */
+ arg1se.want_pointer = 1;
+ gfc_conv_expr (&arg1se, arg1->expr);
+ if (arg1->expr->symtree->n.sym->attr.proc_pointer
+ && arg1->expr->symtree->n.sym->attr.dummy)
+ arg1se.expr = build_fold_indirect_ref_loc (input_location,
+ arg1se.expr);
+ tmp2 = arg1se.expr;
}
else
{
@@ -5794,12 +5824,21 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
if (ss1 == gfc_ss_terminator)
{
- /* A pointer to a scalar. */
- gcc_assert (ss2 == gfc_ss_terminator);
- arg1se.want_pointer = 1;
- gfc_conv_expr (&arg1se, arg1->expr);
- arg2se.want_pointer = 1;
- gfc_conv_expr (&arg2se, arg2->expr);
+ /* A pointer to a scalar. */
+ gcc_assert (ss2 == gfc_ss_terminator);
+ arg1se.want_pointer = 1;
+ gfc_conv_expr (&arg1se, arg1->expr);
+ if (arg1->expr->symtree->n.sym->attr.proc_pointer
+ && arg1->expr->symtree->n.sym->attr.dummy)
+ arg1se.expr = build_fold_indirect_ref_loc (input_location,
+ arg1se.expr);
+
+ arg2se.want_pointer = 1;
+ gfc_conv_expr (&arg2se, arg2->expr);
+ if (arg2->expr->symtree->n.sym->attr.proc_pointer
+ && arg2->expr->symtree->n.sym->attr.dummy)
+ arg2se.expr = build_fold_indirect_ref_loc (input_location,
+ arg2se.expr);
gfc_add_block_to_block (&se->pre, &arg1se.pre);
gfc_add_block_to_block (&se->post, &arg1se.post);
tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
--- /dev/null 2012-03-15 07:05:00.651809558 +0100
+++ /home/tob/projects/gcc-git/gcc/gcc/testsuite/gfortran.dg/proc_ptr_36.f90 2012-03-15 11:34:46.000000000 +0100
@@ -0,0 +1,48 @@
+! { dg-do run }
+!
+! PR fortran/52585
+!
+! Test proc-pointer dummies with ASSOCIATE
+!
+! Contributed by Mat Cross of NAG
+!
+module m0
+ abstract interface
+ subroutine sub
+ end subroutine sub
+ end interface
+ interface
+ subroutine s(ss, isassoc)
+ import sub
+ logical :: isassoc
+ procedure(sub), pointer, intent(in) :: ss
+ end subroutine s
+ end interface
+end module m0
+
+use m0, only : sub, s
+procedure(sub) :: sub2, pp
+pointer :: pp
+pp => sub2
+if (.not. associated(pp)) call abort ()
+if (.not. associated(pp,sub2)) call abort ()
+call s(pp, .true.)
+pp => null()
+if (associated(pp)) call abort ()
+if (associated(pp,sub2)) call abort ()
+call s(pp, .false.)
+end
+
+subroutine s(ss, isassoc)
+ use m0, only : sub
+ logical :: isassoc
+ procedure(sub), pointer, intent(in) :: ss
+ procedure(sub) :: sub2
+ if (isassoc .neqv. associated(ss)) call abort ()
+ if (isassoc .neqv. associated(ss,sub2)) call abort ()
+end subroutine s
+
+subroutine sub2
+end subroutine sub2
+
+! { dg-final { cleanup-modules "m0" } }