gcc/testsuite/gfortran.dg/proc_ptr_36.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/52585
   4 !
   5 ! Test proc-pointer dummies with ASSOCIATE
   6 !
   7 ! Contributed by Mat Cross of NAG
   8 !
   9 module m0
  10   abstract interface
  11     subroutine sub
  12     end subroutine sub
  13   end interface
  14   interface
  15     subroutine s(ss, isassoc)
  16       import sub
  17       logical :: isassoc
  18       procedure(sub), pointer, intent(in) :: ss
  19     end subroutine s
  20   end interface
  21 end module m0
  22
  23 use m0, only : sub, s
  24 procedure(sub) :: sub2, pp
  25 pointer :: pp
  26 pp => sub2
  27 if (.not. associated(pp)) STOP 1
  28 if (.not. associated(pp,sub2)) STOP 2
  29 call s(pp, .true.)
  30 pp => null()
  31 if (associated(pp)) STOP 3
  32 if (associated(pp,sub2)) STOP 4
  33 call s(pp, .false.)
  34 end
  35
  36 subroutine s(ss, isassoc)
  37   use m0, only : sub
  38   logical :: isassoc
  39   procedure(sub), pointer, intent(in) :: ss
  40   procedure(sub) :: sub2
  41   if (isassoc .neqv. associated(ss)) STOP 5
  42   if (isassoc .neqv. associated(ss,sub2)) STOP 6
  43 end subroutine s
  44
  45 subroutine sub2
  46 end subroutine sub2