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