[Patch, Fortran] PR52585 - Fix ASSOCIATE with proc-pointer dummies

[Tobias Burnus <burnus at net-b dot de>]

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  <burnus@net-b.de>

	PR fortran/52585
	* trans-intrinsic.c (gfc_conv_associated): Fix handling of
	procpointer dummy arguments.

2012-03-15  Tobias Burnus  <burnus@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" } }