gcc/testsuite/gfortran.dg/proc_ptr_5.f90

   1 ! { dg-do run }
   2 !
   3 ! NULL() initialization for PROCEDURE POINTERS
   4 !
   5 ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
   6
   7 program main
   8 implicit none
   9 call test(.true.)
  10 call test(.false.)
  11
  12 contains
  13
  14 integer function hello()
  15  hello = 42
  16 end function hello
  17
  18 subroutine test(first)
  19  logical :: first
  20  integer :: i
  21  procedure(integer), pointer :: x => null()
  22
  23  if(first) then
  24   if(associated(x)) call abort()
  25   x => hello
  26  else
  27   if(.not. associated(x)) call abort()
  28   i = x()
  29   if(i /= 42) call abort()
  30  end if
  31  end subroutine test
  32
  33 end program main