1! { dg-do run }
2! Tests the fix for PR67091 in which the first call to associated
3! gave a bad result because the 'target' argument was not being
4! correctly handled.
5!
6! Contributed by 'FortranFan' on clf.
7! https://groups.google.com/forum/#!topic/comp.lang.fortran/dN_tQA1Mu-I
8!
9module m
10   implicit none
11   private
12   type, public :: t
13      private
14      integer, pointer :: m_i
15   contains
16      private
17      procedure, pass(this), public :: iptr => getptr
18      procedure, pass(this), public :: setptr
19   end type t
20contains
21   subroutine setptr( this, iptr )
22      !.. Argument list
23      class(t), intent(inout)         :: this
24      integer, pointer, intent(inout) :: iptr
25      this%m_i => iptr
26      return
27   end subroutine setptr
28   function getptr( this ) result( iptr )
29      !.. Argument list
30      class(t), intent(in) :: this
31      !.. Function result
32      integer, pointer :: iptr
33      iptr => this%m_i
34   end function getptr
35end module m
36
37program p
38   use m, only : t
39   integer, pointer :: i
40   integer, pointer :: j
41   type(t) :: foo
42   !.. create i with some value
43   allocate (i, source=42)
44   call foo%setptr (i)
45   if (.not.associated (i, foo%iptr())) STOP 1 ! Gave bad result.
46   if (.not.associated (foo%iptr(), i)) STOP 2 ! Was OK.
47   j => foo%iptr()
48   if (.not.associated (i, j)) STOP 1! Was OK.
49end program p
50