gcc/testsuite/gfortran.dg/proc_ptr_6.f90

   1 ! { dg-do run }
   2 !
   3 ! PROCEDURE POINTERS as actual/formal arguments
   4 !
   5 ! Contributed by Janus Weil <janus@gcc.gnu.org>
   6
   7 subroutine foo(j)
   8   INTEGER, INTENT(OUT) :: j
   9   j = 6
  10 end subroutine
  11
  12 program proc_ptr_6
  13
  14 PROCEDURE(),POINTER :: ptr1
  15 PROCEDURE(REAL),POINTER :: ptr2
  16 EXTERNAL foo
  17 INTEGER :: k = 0
  18
  19 ptr1 => foo
  20 call s_in(ptr1,k)
  21 if (k /= 6) call abort()
  22
  23 call s_out(ptr2)
  24 if (ptr2(-3.0) /= 3.0) call abort()
  25
  26 contains
  27
  28 subroutine s_in(p,i)
  29   PROCEDURE(),POINTER,INTENT(IN) :: p
  30   INTEGER, INTENT(OUT) :: i
  31   call p(i)
  32 end subroutine
  33
  34 subroutine s_out(p)
  35   PROCEDURE(REAL),POINTER,INTENT(OUT) :: p
  36   p => abs
  37 end subroutine
  38
  39 end program