gcc/testsuite/gfortran.dg/proc_ptr_3.f90

   1 ! { dg-do run }
   2 !
   3 ! PROCEDURE POINTERS without the PROCEDURE statement
   4 !
   5 ! Contributed by Janus Weil <janus@gcc.gnu.org>
   6
   7 real function e1(x)
   8   real :: x
   9   print *,'e1!',x
  10   e1 = x * 3.0
  11 end function
  12
  13 subroutine e2(a,b)
  14   real, intent(inout) :: a
  15   real, intent(in) :: b
  16   print *,'e2!',a,b
  17   a = a + b
  18 end subroutine
  19
  20 program proc_ptr_3
  21
  22 real, external, pointer :: fp
  23
  24 pointer :: sp
  25 interface
  26   subroutine sp(a,b)
  27     real, intent(inout) :: a
  28     real, intent(in) :: b
  29   end subroutine sp
  30 end interface
  31
  32 external :: e1,e2
  33 real :: c = 1.2
  34
  35 fp => e1
  36
  37 if (abs(fp(2.5)-7.5)>0.01) call abort()
  38
  39 sp => e2
  40
  41 call sp(c,3.4)
  42
  43 if (abs(c-4.6)>0.01) call abort()
  44
  45 end