1! RUN: %S/test_modfile.sh %s %t %flang_fc1
2! REQUIRES: shell
3! Test that subprogram interfaces get all of the symbols that they need.
4
5module m1
6  integer(8) :: i
7  type t1
8    sequence
9    integer :: j
10  end type
11  type t2
12  end type
13end
14!Expect: m1.mod
15!module m1
16! integer(8)::i
17! type::t1
18!  sequence
19!  integer(4)::j
20! end type
21! type::t2
22! end type
23!end
24
25module m2
26  integer(8) :: k
27contains
28  subroutine s(a, j)
29    use m1
30    integer(8) :: j
31    real :: a(i:j,1:k)  ! need i from m1
32  end
33end
34!Expect: m2.mod
35!module m2
36! integer(8)::k
37!contains
38! subroutine s(a,j)
39!  use m1,only:i
40!  integer(8)::j
41!  real(4)::a(i:j,1_8:k)
42! end
43!end
44
45module m3
46  implicit none
47contains
48  subroutine s(b, n)
49    type t2
50    end type
51    type t4(l)
52      integer, len :: l
53      type(t2) :: x  ! need t2
54    end type
55    integer :: n
56    type(t4(n)) :: b
57  end
58end module
59!Expect: m3.mod
60!module m3
61!contains
62! subroutine s(b,n)
63!  integer(4)::n
64!  type::t2
65!  end type
66!  type::t4(l)
67!   integer(4),len::l
68!   type(t2)::x
69!  end type
70!  type(t4(l=n))::b
71! end
72!end
73
74module m4
75contains
76  subroutine s1(a)
77    use m1
78    common /c/x,n  ! x is needed
79    integer(8) :: n
80    real :: a(n)
81    type(t1) :: x
82  end
83end
84!Expect: m4.mod
85!module m4
86!contains
87! subroutine s1(a)
88!  use m1,only:t1
89!  type(t1)::x
90!  common/c/x,n
91!  integer(8)::n
92!  real(4)::a(1_8:n)
93! end
94!end
95
96module m5
97  type t5
98  end type
99  interface
100    subroutine s(x1,x5)
101      use m1
102      import :: t5
103      type(t1) :: x1
104      type(t5) :: x5
105    end subroutine
106  end interface
107end
108!Expect: m5.mod
109!module m5
110! type::t5
111! end type
112! interface
113!  subroutine s(x1,x5)
114!   use m1,only:t1
115!   import::t5
116!   type(t1)::x1
117!   type(t5)::x5
118!  end
119! end interface
120!end
121
122module m6
123contains
124  subroutine s(x)
125    use m1
126    type, extends(t2) :: t6
127    end type
128    type, extends(t6) :: t7
129    end type
130    type(t7) :: x
131  end
132end
133!Expect: m6.mod
134!module m6
135!contains
136! subroutine s(x)
137!  use m1,only:t2
138!  type,extends(t2)::t6
139!  end type
140!  type,extends(t6)::t7
141!  end type
142!  type(t7)::x
143! end
144!end
145
146module m7
147  type :: t5(l)
148    integer, len :: l
149  end type
150contains
151  subroutine s1(x)
152    use m1
153    type(t5(i)) :: x
154  end subroutine
155  subroutine s2(x)
156    use m1
157    character(i) :: x
158  end subroutine
159end
160!Expect: m7.mod
161!module m7
162! type::t5(l)
163!  integer(4),len::l
164! end type
165!contains
166! subroutine s1(x)
167!  use m1,only:i
168!  type(t5(l=int(i,kind=4)))::x
169! end
170! subroutine s2(x)
171!  use m1,only:i
172!  character(i,1)::x
173! end
174!end
175
176module m8
177  use m1, only: t1, t2
178  interface
179    subroutine s1(x)
180      import
181      type(t1) :: x
182    end subroutine
183    subroutine s2(x)
184      import :: t2
185      type(t2) :: x
186    end subroutine
187  end interface
188end
189!Expect: m8.mod
190!module m8
191! use m1,only:t1
192! use m1,only:t2
193! interface
194!  subroutine s1(x)
195!   import::t1
196!   type(t1)::x
197!  end
198! end interface
199! interface
200!  subroutine s2(x)
201!   import::t2
202!   type(t2)::x
203!  end
204! end interface
205!end
206