1! RUN: %S/test_modfile.sh %s %t %f18
2! Resolution of generic names in expressions.
3! Test by using generic function in a specification expression that needs
4! to be written to a .mod file.
5
6! Resolve based on number of arguments
7module m1
8  interface f
9    pure integer(8) function f1(x)
10      real, intent(in) :: x
11    end
12    pure integer(8) function f2(x, y)
13      real, intent(in) :: x, y
14    end
15    pure integer(8) function f3(x, y, z, w)
16      real, intent(in) :: x, y, z, w
17      optional :: w
18    end
19  end interface
20contains
21  subroutine s1(x, z)
22    real :: z(f(x))  ! resolves to f1
23  end
24  subroutine s2(x, y, z)
25    real :: z(f(x, y))  ! resolves to f2
26  end
27  subroutine s3(x, y, z, w)
28    real :: w(f(x, y, z))  ! resolves to f3
29  end
30  subroutine s4(x, y, z, w, u)
31    real :: u(f(x, y, z, w))  ! resolves to f3
32  end
33end
34!Expect: m1.mod
35!module m1
36! interface f
37!  procedure :: f1
38!  procedure :: f2
39!  procedure :: f3
40! end interface
41! interface
42!  pure function f1(x)
43!   real(4), intent(in) :: x
44!   integer(8) :: f1
45!  end
46! end interface
47! interface
48!  pure function f2(x, y)
49!   real(4), intent(in) :: x
50!   real(4), intent(in) :: y
51!   integer(8) :: f2
52!  end
53! end interface
54! interface
55!  pure function f3(x, y, z, w)
56!   real(4), intent(in) :: x
57!   real(4), intent(in) :: y
58!   real(4), intent(in) :: z
59!   real(4), intent(in), optional :: w
60!   integer(8) :: f3
61!  end
62! end interface
63!contains
64! subroutine s1(x, z)
65!  real(4) :: x
66!  real(4) :: z(1_8:f1(x))
67! end
68! subroutine s2(x, y, z)
69!  real(4) :: x
70!  real(4) :: y
71!  real(4) :: z(1_8:f2(x, y))
72! end
73! subroutine s3(x, y, z, w)
74!  real(4) :: x
75!  real(4) :: y
76!  real(4) :: z
77!  real(4) :: w(1_8:f3(x, y, z))
78! end
79! subroutine s4(x, y, z, w, u)
80!  real(4) :: x
81!  real(4) :: y
82!  real(4) :: z
83!  real(4) :: w
84!  real(4) :: u(1_8:f3(x, y, z, w))
85! end
86!end
87
88! Resolve based on type or kind
89module m2
90  interface f
91    pure integer(8) function f_real4(x)
92      real(4), intent(in) :: x
93    end
94    pure integer(8) function f_real8(x)
95      real(8), intent(in) :: x
96    end
97    pure integer(8) function f_integer(x)
98      integer, intent(in) :: x
99    end
100  end interface
101contains
102  subroutine s1(x, y)
103    real(4) :: x
104    real :: y(f(x))  ! resolves to f_real4
105  end
106  subroutine s2(x, y)
107    real(8) :: x
108    real :: y(f(x))  ! resolves to f_real8
109  end
110  subroutine s3(x, y)
111    integer :: x
112    real :: y(f(x))  ! resolves to f_integer
113  end
114end
115!Expect: m2.mod
116!module m2
117! interface f
118!  procedure :: f_real4
119!  procedure :: f_real8
120!  procedure :: f_integer
121! end interface
122! interface
123!  pure function f_real4(x)
124!   real(4), intent(in) :: x
125!   integer(8) :: f_real4
126!  end
127! end interface
128! interface
129!  pure function f_real8(x)
130!   real(8), intent(in) :: x
131!   integer(8) :: f_real8
132!  end
133! end interface
134! interface
135!  pure function f_integer(x)
136!   integer(4), intent(in) :: x
137!   integer(8) :: f_integer
138!  end
139! end interface
140!contains
141! subroutine s1(x, y)
142!  real(4) :: x
143!  real(4) :: y(1_8:f_real4(x))
144! end
145! subroutine s2(x, y)
146!  real(8) :: x
147!  real(4) :: y(1_8:f_real8(x))
148! end
149! subroutine s3(x, y)
150!  integer(4) :: x
151!  real(4) :: y(1_8:f_integer(x))
152! end
153!end
154
155! Resolve based on rank
156module m3a
157  interface f
158    procedure :: f_elem
159    procedure :: f_vector
160  end interface
161contains
162  pure integer(8) elemental function f_elem(x) result(result)
163    real, intent(in) :: x
164    result = 1_8
165  end
166  pure integer(8) function f_vector(x) result(result)
167    real, intent(in) :: x(:)
168    result = 2_8
169  end
170end
171!Expect: m3a.mod
172!module m3a
173! interface f
174!  procedure :: f_elem
175!  procedure :: f_vector
176! end interface
177!contains
178! elemental pure function f_elem(x) result(result)
179!  real(4), intent(in) :: x
180!  integer(8) :: result
181! end
182! pure function f_vector(x) result(result)
183!  real(4), intent(in) :: x(:)
184!  integer(8) :: result
185! end
186!end
187
188module m3b
189use m3a
190contains
191  subroutine s1(x, y)
192    real :: x
193    real :: y(f(x))  ! resolves to f_elem
194  end
195  subroutine s2(x, y)
196    real :: x(10)
197    real :: y(f(x))  ! resolves to f_vector (preferred over elemental one)
198  end
199  subroutine s3(x, y)
200    real :: x(10, 10)
201    real :: y(ubound(f(x), 1))  ! resolves to f_elem
202  end
203end
204!Expect: m3b.mod
205!module m3b
206! use m3a, only: f
207! use m3a, only: f_elem
208! use m3a, only: f_vector
209!contains
210! subroutine s1(x, y)
211!  real(4) :: x
212!  real(4) :: y(1_8:f_elem(x))
213! end
214! subroutine s2(x, y)
215!  real(4) :: x(1_8:10_8)
216!  real(4) :: y(1_8:f_vector(x))
217! end
218! subroutine s3(x, y)
219!  real(4) :: x(1_8:10_8, 1_8:10_8)
220!  real(4) :: y(1_8:10_8)
221! end
222!end
223
224! Resolve defined unary operator based on type
225module m4
226  interface operator(.foo.)
227    pure integer(8) function f_real(x)
228      real, intent(in) :: x
229    end
230    pure integer(8) function f_integer(x)
231      integer, intent(in) :: x
232    end
233  end interface
234contains
235  subroutine s1(x, y)
236    real :: x
237    real :: y(.foo. x)  ! resolves to f_real
238  end
239  subroutine s2(x, y)
240    integer :: x
241    real :: y(.foo. x)  ! resolves to f_integer
242  end
243end
244!Expect: m4.mod
245!module m4
246! interface operator(.foo.)
247!  procedure :: f_real
248!  procedure :: f_integer
249! end interface
250! interface
251!  pure function f_real(x)
252!   real(4), intent(in) :: x
253!   integer(8) :: f_real
254!  end
255! end interface
256! interface
257!  pure function f_integer(x)
258!   integer(4), intent(in) :: x
259!   integer(8) :: f_integer
260!  end
261! end interface
262!contains
263! subroutine s1(x, y)
264!  real(4) :: x
265!  real(4) :: y(1_8:f_real(x))
266! end
267! subroutine s2(x, y)
268!  integer(4) :: x
269!  real(4) :: y(1_8:f_integer(x))
270! end
271!end
272
273! Resolve defined binary operator based on type
274module m5
275  interface operator(.foo.)
276    pure integer(8) function f1(x, y)
277      real, intent(in) :: x
278      real, intent(in) :: y
279    end
280    pure integer(8) function f2(x, y)
281      real, intent(in) :: x
282      complex, intent(in) :: y
283    end
284  end interface
285contains
286  subroutine s1(x, y)
287    complex :: x
288    real :: y(1.0 .foo. x)  ! resolves to f2
289  end
290  subroutine s2(x, y)
291    real :: x
292    real :: y(1.0 .foo. x)  ! resolves to f1
293  end
294end
295!Expect: m5.mod
296!module m5
297! interface operator(.foo.)
298!  procedure :: f1
299!  procedure :: f2
300! end interface
301! interface
302!  pure function f1(x, y)
303!   real(4), intent(in) :: x
304!   real(4), intent(in) :: y
305!   integer(8) :: f1
306!  end
307! end interface
308! interface
309!  pure function f2(x, y)
310!   real(4), intent(in) :: x
311!   complex(4), intent(in) :: y
312!   integer(8) :: f2
313!  end
314! end interface
315!contains
316! subroutine s1(x, y)
317!  complex(4) :: x
318!  real(4) :: y(1_8:f2(1._4, x))
319! end
320! subroutine s2(x, y)
321!  real(4) :: x
322!  real(4) :: y(1_8:f1(1._4, x))
323! end
324!end
325