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

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e5b7681..5bb70f1 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+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.

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 967a741..1aa299b 100644 (file)
--- a/gcc/fortran/trans-intrinsic.c
+++ b/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,

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8117434..2bbe2a2 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/associated_target_6.f03 b/gcc/testsuite/gfortran.dg/associated_target_6.f03
new file mode 100644 (file)
index 0000000..15f7951
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associated_target_6.f03
@@ -0,0 +1,49 @@
+! { 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