1! { dg-do run } 2! Various runtime tests of PROCEDURE declarations. 3! Contributed by Janus Weil <jaydub66@gmail.com> 4 5module m 6 7 use ISO_C_BINDING 8 9 abstract interface 10 subroutine csub() bind(c) 11 end subroutine csub 12 end interface 13 14 integer, parameter :: ckind = C_FLOAT_COMPLEX 15 abstract interface 16 function stub() bind(C) 17 import ckind 18 complex(ckind) stub 19 end function 20 end interface 21 22 procedure():: mp1 23 procedure(real), private:: mp2 24 procedure(mfun), public:: mp3 25 procedure(csub), public, bind(c) :: c, d 26 procedure(csub), public, bind(c, name="myB") :: b 27 procedure(stub), bind(C) :: e 28 29contains 30 31 real function mfun(x,y) 32 real x,y 33 mfun=4.2 34 end function 35 36 subroutine bar(a,b) 37 implicit none 38 interface 39 subroutine a() 40 end subroutine a 41 end interface 42 optional :: a 43 procedure(a), optional :: b 44 end subroutine bar 45 46 subroutine bar2(x) 47 abstract interface 48 character function abs_fun() 49 end function 50 end interface 51 procedure(abs_fun):: x 52 end subroutine 53 54 55end module 56 57 58program p 59 implicit none 60 61 abstract interface 62 subroutine abssub(x) 63 real x 64 end subroutine 65 end interface 66 67 integer i 68 real r 69 70 procedure(integer):: p1 71 procedure(fun):: p2 72 procedure(abssub):: p3 73 procedure(sub):: p4 74 procedure():: p5 75 procedure(p4):: p6 76 procedure(integer) :: p7 77 78 i=p1() 79 if (i /= 5) call abort() 80 i=p2(3.1) 81 if (i /= 3) call abort() 82 r=4.2 83 call p3(r) 84 if (abs(r-5.2)>1e-6) call abort() 85 call p4(r) 86 if (abs(r-3.7)>1e-6) call abort() 87 call p5() 88 call p6(r) 89 if (abs(r-7.4)>1e-6) call abort() 90 i=p7(4) 91 if (i /= -8) call abort() 92 r=dummytest(p3) 93 if (abs(r-2.1)>1e-6) call abort() 94 95contains 96 97 integer function fun(x) 98 real x 99 fun=7 100 end function 101 102 subroutine sub(x) 103 real x 104 end subroutine 105 106 real function dummytest(dp) 107 procedure(abssub):: dp 108 real y 109 y=1.1 110 call dp(y) 111 dummytest=y 112 end function 113 114end program p 115 116 117integer function p1() 118 p1 = 5 119end function 120 121integer function p2(x) 122 real x 123 p2 = int(x) 124end function 125 126subroutine p3(x) 127 real :: x 128 x=x+1.0 129end subroutine 130 131subroutine p4(x) 132 real :: x 133 x=x-1.5 134end subroutine 135 136subroutine p5() 137end subroutine 138 139subroutine p6(x) 140 real :: x 141 x=x*2. 142end subroutine 143 144function p7(x) 145 implicit none 146 integer :: x, p7 147 p7 = x*(-2) 148end function 149