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