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