gcc/testsuite/gfortran.dg/associated_target_3.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/41777
   4 !
   5 module m
   6 type t2
   7  integer :: i
   8 end type t2
   9 interface f
  10  module procedure f2
  11 end interface f
  12 contains
  13 function f2(a)
  14   type(t2), pointer :: f2,a
  15   f2 => a
  16 end function f2
  17 end module m
  18
  19 use m
  20 implicit none
  21 type(t2), pointer :: a
  22 allocate(a)
  23 if (.not. associated(a,f(a))) STOP 1
  24 call cmpPtr(a,f2(a))
  25 call cmpPtr(a,f(a))
  26 deallocate(a)
  27 contains
  28   subroutine cmpPtr(a,b)
  29     type(t2), pointer :: a,b
  30 !    print *, associated(a,b)
  31     if (.not. associated (a, b)) STOP 2
  32   end subroutine cmpPtr
  33 end