gcc/testsuite/gfortran.dg/submodule_30.f08

   1 ! { dg-do run }
   2 !
   3 ! Test the fix for PR82550 in which the reference to 'p' in 'foo'
   4 ! was not being correctly handled.
   5 !
   6 ! Contributed by Reinhold Bader  <Bader@lrz.de>
   7 !
   8 module m_subm_18_pos
   9   implicit none
  10   integer :: i = 0
  11   interface
  12     module subroutine foo(fun_ptr)
  13       procedure(p), pointer, intent(out) :: fun_ptr
  14     end subroutine
  15   end interface
  16 contains
  17   subroutine p()
  18     i = 1
  19   end subroutine p
  20 end module m_subm_18_pos
  21 submodule (m_subm_18_pos) subm_18_pos
  22     implicit none
  23 contains
  24     module subroutine foo(fun_ptr)
  25       procedure(p), pointer, intent(out) :: fun_ptr
  26       fun_ptr => p
  27     end subroutine
  28 end submodule
  29 program p_18_pos
  30   use m_subm_18_pos
  31   implicit none
  32   procedure(), pointer :: x
  33   call foo(x)
  34   call x()
  35   if (i == 1) then
  36      write(*,*) 'OK'
  37   else
  38      write(*,*) 'FAIL'
  39      STOP 1
  40   end if
  41 end program p_18_pos
  42