gcc/testsuite/gfortran.dg/proc_ptr_3.f90

   1 ! { dg-do run }
   2 ! { dg-require-visibility "" }
   3 !
   4 ! PROCEDURE POINTERS without the PROCEDURE statement
   5 !
   6 ! Contributed by Janus Weil <janus@gcc.gnu.org>
   7
   8 real function e1(x)
   9   real :: 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   a = a + b
  17 end subroutine
  18
  19 program proc_ptr_3
  20
  21 real, external, pointer :: fp
  22
  23 pointer :: sp
  24 interface
  25   subroutine sp(a,b)
  26     real, intent(inout) :: a
  27     real, intent(in) :: b
  28   end subroutine sp
  29 end interface
  30
  31 real, external :: e1
  32
  33 interface
  34   subroutine e2(a,b)
  35     real, intent(inout) :: a
  36     real, intent(in) :: b
  37   end subroutine e2
  38 end interface
  39
  40 real :: c = 1.2
  41
  42 fp => e1
  43
  44 if (abs(fp(2.5)-7.5)>0.01) call abort()
  45
  46 sp => e2
  47
  48 call sp(c,3.4)
  49
  50 if (abs(c-4.6)>0.01) call abort()
  51
  52 end