re PR fortran/52585 (Wrong result for ASSOCIATED with dummy procedure pointer)

2012-03-17  Tobias Burnus  <burnus@net-b.de>

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

2012-03-17  Tobias Burnus  <burnus@net-b.de>

        PR fortran/52585
        * gfortran.dg/proc_ptr_36.f90: New.

From-SVN: r185485

gcc/fortran/ChangeLog

@@ -1,3 +1,9 @@
+2012-03-17  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/52585
+	* trans-intrinsic.c (gfc_conv_associated): Fix handling of
+	procpointer dummy arguments.
+
 2012-03-16  Janne Blomqvist  <jb@gcc.gnu.org>
 
 	* trans-intrinsic.c (build_round_expr): Don't use BUILT_IN_IROUND

gcc/fortran/trans-intrinsic.c

@@ -5764,6 +5764,10 @@ gfc_conv_associated (gfc_se *se, gfc_expr *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
@@ -5798,8 +5802,17 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
 	  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,

gcc/testsuite/ChangeLog

@@ -1,3 +1,8 @@
+2012-03-17  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/52585
+	* gfortran.dg/proc_ptr_36.f90: New.
+
 2012-03-16  Martin Jambor  <mjambor@suse.cz>
 
 	* gcc.dg/misaligned-expand-1.c: New test.

gcc/testsuite/gfortran.dg/proc_ptr_36.f90

@@ -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" } }