re PR fortran/67091 ([OOP] Bad result for type-bound procedures returning…

re PR fortran/67091 ([OOP] Bad result for type-bound procedures returning pointers to the intrinsic function ASSOCIATED)

2015-08-01  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/67091
	* trans-intrinsic.c (gfc_conv_associated): Add the pre and post
	blocks for the second argument to se.

2015-08-01  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/67091
	* gfortran.dg/associated_target_6.f03: New test

From-SVN: r226464

gcc/fortran/ChangeLog

+2015-08-01  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/67091
+	* trans-intrinsic.c (gfc_conv_associated): Add the pre and post
+	blocks for the second argument to se.
+
 2015-07-27  Thomas Schwinge  <thomas@codesourcery.com>
 
 	* parse.c (parse_oacc_structured_block): Fix logic error.

gcc/fortran/trans-intrinsic.c

@@ -6667,6 +6667,8 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
 						       arg2se.expr);
 	  gfc_add_block_to_block (&se->pre, &arg1se.pre);
 	  gfc_add_block_to_block (&se->post, &arg1se.post);
+	  gfc_add_block_to_block (&se->pre, &arg2se.pre);
+	  gfc_add_block_to_block (&se->post, &arg2se.post);
           tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
 				 arg1se.expr, arg2se.expr);
           tmp2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,

gcc/testsuite/ChangeLog

+2015-08-01  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/67091
+	* gfortran.dg/associated_target_6.f03: New test
+
 2015-08-01  Tom de Vries  <tom@codesourcery.com>
 
 	* gcc.dg/autopar/reduc-2char.c (init_arrays): Mark with attribute

gcc/testsuite/gfortran.dg/associated_target_6.f03

+! { dg-do run }
+! Tests the fix for PR67091 in which the first call to associated
+! gave a bad result because the 'target' argument was not being
+! correctly handled.
+!
+! Contributed by 'FortranFan' on clf.
+! https://groups.google.com/forum/#!topic/comp.lang.fortran/dN_tQA1Mu-I
+!
+module m
+   implicit none
+   private
+   type, public :: t
+      private
+      integer, pointer :: m_i
+   contains
+      private
+      procedure, pass(this), public :: iptr => getptr
+      procedure, pass(this), public :: setptr
+   end type t
+contains
+   subroutine setptr( this, iptr )
+      !.. Argument list
+      class(t), intent(inout)         :: this
+      integer, pointer, intent(inout) :: iptr
+      this%m_i => iptr
+      return
+   end subroutine setptr
+   function getptr( this ) result( iptr )
+      !.. Argument list
+      class(t), intent(in) :: this
+      !.. Function result
+      integer, pointer :: iptr
+      iptr => this%m_i
+   end function getptr
+end module m
+
+program p
+   use m, only : t
+   integer, pointer :: i
+   integer, pointer :: j
+   type(t) :: foo
+   !.. create i with some value
+   allocate (i, source=42)
+   call foo%setptr (i)
+   if (.not.associated (i, foo%iptr())) call abort () ! Gave bad result.
+   if (.not.associated (foo%iptr(), i)) call abort () ! Was OK.
+   j => foo%iptr()
+   if (.not.associated (i, j)) call abort ! Was OK.
+end program p