[LoopReroll] Add an extra defensive check to avoid SCEV assertion.
[llvm-project.git] / flang / test / Semantics / modfile35.f90
blob207eee002a65f656649f4c30e123a835ff414228
1 ! RUN: %S/test_modfile.sh %s %t %flang_fc1
2 ! REQUIRES: shell
3 module m1
4 type :: t1
5 contains
6 procedure, pass(x) :: p1 => f
7 procedure, non_overridable :: p2 => f
8 procedure, nopass :: p3 => f
9 generic :: operator(+) => p1
10 generic :: operator(-) => p2
11 generic :: operator(<) => p1
12 generic :: operator(.and.) => p2
13 end type
14 contains
15 integer(8) pure function f(x, y)
16 class(t1), intent(in) :: x
17 integer, intent(in) :: y
18 end
19 ! Operators resolve to type-bound operators in t1
20 subroutine test1(x, y, a, b)
21 class(t1) :: x
22 integer :: y
23 real :: a(x + y)
24 real :: b(x .lt. y)
25 end
26 ! Operators resolve to type-bound operators in t1, compile-time resolvable
27 subroutine test2(x, y, a, b)
28 class(t1) :: x
29 integer :: y
30 real :: a(x - y)
31 real :: b(x .and. y)
32 end
33 ! Operators resolve to type-bound operators in t1, compile-time resolvable
34 subroutine test3(x, y, a)
35 type(t1) :: x
36 integer :: y
37 real :: a(x + y)
38 end
39 end
40 !Expect: m1.mod
41 !module m1
42 ! type :: t1
43 ! contains
44 ! procedure, pass(x) :: p1 => f
45 ! procedure, non_overridable :: p2 => f
46 ! procedure, nopass :: p3 => f
47 ! generic :: operator(+) => p1
48 ! generic :: operator(-) => p2
49 ! generic :: operator(<) => p1
50 ! generic :: operator(.and.) => p2
51 ! end type
52 !contains
53 ! pure function f(x, y)
54 ! class(t1), intent(in) :: x
55 ! integer(4), intent(in) :: y
56 ! integer(8) :: f
57 ! end
58 ! subroutine test1(x, y, a, b)
59 ! class(t1) :: x
60 ! integer(4) :: y
61 ! real(4) :: a(1_8:x%p1(y))
62 ! real(4) :: b(1_8:x%p1(y))
63 ! end
64 ! subroutine test2(x, y, a, b)
65 ! class(t1) :: x
66 ! integer(4) :: y
67 ! real(4) :: a(1_8:f(x, y))
68 ! real(4) :: b(1_8:f(x, y))
69 ! end
70 ! subroutine test3(x,y,a)
71 ! type(t1) :: x
72 ! integer(4) :: y
73 ! real(4) :: a(1_8:f(x,y))
74 ! end
75 !end
77 module m2
78 type :: t1
79 contains
80 procedure, pass(x) :: p1 => f1
81 generic :: operator(+) => p1
82 end type
83 type, extends(t1) :: t2
84 contains
85 procedure, pass(y) :: p2 => f2
86 generic :: operator(+) => p2
87 end type
88 contains
89 integer(8) pure function f1(x, y)
90 class(t1), intent(in) :: x
91 integer, intent(in) :: y
92 end
93 integer(8) pure function f2(x, y)
94 class(t1), intent(in) :: x
95 class(t2), intent(in) :: y
96 end
97 subroutine test1(x, y, a)
98 class(t1) :: x
99 integer :: y
100 real :: a(x + y)
102 ! Resolve to operator in parent class
103 subroutine test2(x, y, a)
104 class(t2) :: x
105 integer :: y
106 real :: a(x + y)
108 ! 2nd arg is passed object
109 subroutine test3(x, y, a)
110 class(t1) :: x
111 class(t2) :: y
112 real :: a(x + y)
115 !Expect: m2.mod
116 !module m2
117 ! type :: t1
118 ! contains
119 ! procedure, pass(x) :: p1 => f1
120 ! generic :: operator(+) => p1
121 ! end type
122 ! type, extends(t1) :: t2
123 ! contains
124 ! procedure, pass(y) :: p2 => f2
125 ! generic :: operator(+) => p2
126 ! end type
127 !contains
128 ! pure function f1(x, y)
129 ! class(t1), intent(in) :: x
130 ! integer(4), intent(in) :: y
131 ! integer(8) :: f1
132 ! end
133 ! pure function f2(x, y)
134 ! class(t1), intent(in) :: x
135 ! class(t2), intent(in) :: y
136 ! integer(8) :: f2
137 ! end
138 ! subroutine test1(x, y, a)
139 ! class(t1) :: x
140 ! integer(4) :: y
141 ! real(4) :: a(1_8:x%p1(y))
142 ! end
143 ! subroutine test2(x, y, a)
144 ! class(t2) :: x
145 ! integer(4) :: y
146 ! real(4) :: a(1_8:x%p1(y))
147 ! end
148 ! subroutine test3(x, y, a)
149 ! class(t1) :: x
150 ! class(t2) :: y
151 ! real(4) :: a(1_8:y%p2(x))
152 ! end
153 !end
155 module m3
156 type :: t1
157 contains
158 procedure, pass(x) :: p1 => f1
159 procedure :: p3 => f3
160 generic :: operator(.binary.) => p1
161 generic :: operator(.unary.) => p3
162 end type
163 type, extends(t1) :: t2
164 contains
165 procedure, pass(y) :: p2 => f2
166 generic :: operator(.binary.) => p2
167 end type
168 contains
169 integer(8) pure function f1(x, y)
170 class(t1), intent(in) :: x
171 integer, intent(in) :: y
173 integer(8) pure function f2(x, y)
174 class(t1), intent(in) :: x
175 class(t2), intent(in) :: y
177 integer(8) pure function f3(x)
178 class(t1), intent(in) :: x
180 subroutine test1(x, y, a)
181 class(t1) :: x
182 integer :: y
183 real :: a(x .binary. y)
185 ! Resolve to operator in parent class
186 subroutine test2(x, y, a)
187 class(t2) :: x
188 integer :: y
189 real :: a(x .binary. y)
191 ! 2nd arg is passed object
192 subroutine test3(x, y, a)
193 class(t1) :: x
194 class(t2) :: y
195 real :: a(x .binary. y)
197 subroutine test4(x, y, a)
198 class(t1) :: x
199 class(t2) :: y
200 real :: a(.unary. x + .unary. y)
203 !Expect: m3.mod
204 !module m3
205 ! type::t1
206 ! contains
207 ! procedure,pass(x)::p1=>f1
208 ! procedure::p3=>f3
209 ! generic::operator(.binary.)=>p1
210 ! generic::operator(.unary.)=>p3
211 ! end type
212 ! type,extends(t1)::t2
213 ! contains
214 ! procedure,pass(y)::p2=>f2
215 ! generic::operator(.binary.)=>p2
216 ! end type
217 !contains
218 ! pure function f1(x,y)
219 ! class(t1),intent(in)::x
220 ! integer(4),intent(in)::y
221 ! integer(8)::f1
222 ! end
223 ! pure function f2(x,y)
224 ! class(t1),intent(in)::x
225 ! class(t2),intent(in)::y
226 ! integer(8)::f2
227 ! end
228 ! pure function f3(x)
229 ! class(t1),intent(in)::x
230 ! integer(8)::f3
231 ! end
232 ! subroutine test1(x,y,a)
233 ! class(t1)::x
234 ! integer(4)::y
235 ! real(4)::a(1_8:x%p1(y))
236 ! end
237 ! subroutine test2(x,y,a)
238 ! class(t2)::x
239 ! integer(4)::y
240 ! real(4)::a(1_8:x%p1(y))
241 ! end
242 ! subroutine test3(x,y,a)
243 ! class(t1)::x
244 ! class(t2)::y
245 ! real(4)::a(1_8:y%p2(x))
246 ! end
247 ! subroutine test4(x,y,a)
248 ! class(t1)::x
249 ! class(t2)::y
250 ! real(4)::a(1_8:x%p3()+y%p3())
251 ! end
252 !end