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   e1 = x * 3.0
  10 end function
  11
  12 subroutine e2(a,b)
  13   real, intent(inout) :: a
  14   real, intent(in) :: b
  15   a = a + b
  16 end subroutine
  17
  18 program proc_ptr_3
  19
  20 real, external, pointer :: fp
  21
  22 pointer :: sp
  23 interface
  24   subroutine sp(a,b)
  25     real, intent(inout) :: a
  26     real, intent(in) :: b
  27   end subroutine sp
  28 end interface
  29
  30 real, external :: e1
  31
  32 interface
  33   subroutine e2(a,b)
  34     real, intent(inout) :: a
  35     real, intent(in) :: b
  36   end subroutine e2
  37 end interface
  38
  39 real :: c = 1.2
  40
  41 fp => e1
  42
  43 if (abs(fp(2.5)-7.5)>0.01) call abort()
  44
  45 sp => e2
  46
  47 call sp(c,3.4)
  48
  49 if (abs(c-4.6)>0.01) call abort()
  50
  51 end