Lines Matching +full:- +full:y
1 ! RUN: %python %S/test_modfile.py %s %flang_fc1 -flogical-abbreviations -fxor-operator
3 ! Resolution of user-defined operators in expressions.
14 pure integer(8) function add_ll(x, y)
15 logical, intent(in) :: x, y local
17 pure integer(8) function add_li(x, y)
19 integer, intent(in) :: y local
21 pure integer(8) function add_tt(x, y)
23 type(t), intent(in) :: x, y local
27 pure integer(8) function div_tz(x, y)
30 complex, intent(in) :: y local
32 pure integer(8) function div_ct(x, y)
35 type(t), intent(in) :: y local
39 subroutine s1(x, y, z) argument
40 logical :: x, y local
41 real :: z(x + y) ! resolves to add_ll
43 subroutine s2(x, y, z) argument
45 integer :: y local
46 real :: z(x + y) ! resolves to add_li
48 subroutine s3(x, y, z) argument
50 complex :: y local
51 real :: z(x / y) ! resolves to div_tz
53 subroutine s4(x, y, z) argument
55 type(t) :: y local
56 real :: z(x / y) ! resolves to div_ct
67 ! pure function add_ll(x, y)
69 ! logical(4), intent(in) :: y
74 ! pure function add_li(x, y)
76 ! integer(4), intent(in) :: y
81 ! pure function add_tt(x, y)
84 ! type(t), intent(in) :: y
89 ! pure function div_tz(x, y)
92 ! complex(4), intent(in) :: y
97 ! pure function div_ct(x, y)
100 ! type(t), intent(in) :: y
114 ! subroutine s1(x, y, z)
116 ! logical(4) :: y
117 ! real(4) :: z(1_8:add_ll(x, y))
119 ! subroutine s2(x, y, z)
121 ! integer(4) :: y
122 ! real(4) :: z(1_8:add_li(x, y))
124 ! subroutine s3(x, y, z)
126 ! complex(4) :: y
127 ! real(4) :: z(1_8:div_tz(x, y))
129 ! subroutine s4(x, y, z)
131 ! type(t) :: y
132 ! real(4) :: z(1_8:div_ct(x, y))
143 pure integer(8) function and_ti(x, y)
146 integer, intent(in) :: y local
148 pure integer(8) function and_li(x, y)
150 integer, intent(in) :: y local
155 pure integer(8) function and_tt(x, y)
157 type(t), intent(in) :: x, y local
161 pure integer(8) function neqv_tt(x, y)
163 type(t), intent(in) :: x, y local
167 pure integer(8) function neqv_rr(x, y)
168 real, intent(in) :: x, y local
172 subroutine s1(x, y, z) argument
174 integer :: y local
175 real :: z(x .and. y) ! resolves to and_ti
177 subroutine s2(x, y, z) argument
179 integer :: y local
180 real :: z(x .a. y) ! resolves to and_li
182 subroutine s3(x, y, z) argument
183 type(t) :: x, y local
184 real :: z(x .and. y) ! resolves to and_tt
186 subroutine s4(x, y, z) argument
187 type(t) :: x, y local
188 real :: z(x .neqv. y) ! resolves to neqv_tt
190 subroutine s5(x, y, z) argument
191 real :: x, y local
192 real :: z(x .xor. y) ! resolves to neqv_rr
203 ! pure function and_ti(x, y)
206 ! integer(4), intent(in) :: y
211 ! pure function and_li(x, y)
213 ! integer(4), intent(in) :: y
218 ! pure function and_tt(x, y)
221 ! type(t), intent(in) :: y
226 ! pure function neqv_tt(x, y)
229 ! type(t), intent(in) :: y
234 ! pure function neqv_rr(x, y)
236 ! real(4), intent(in) :: y
250 ! subroutine s1(x, y, z)
252 ! integer(4) :: y
253 ! real(4) :: z(1_8:and_ti(x, y))
255 ! subroutine s2(x, y, z)
257 ! integer(4) :: y
258 ! real(4) :: z(1_8:and_li(x, y))
260 ! subroutine s3(x, y, z)
262 ! type(t) :: y
263 ! real(4) :: z(1_8:and_tt(x, y))
265 ! subroutine s4(x, y, z)
267 ! type(t) :: y
268 ! real(4) :: z(1_8:neqv_tt(x, y))
270 ! subroutine s5(x, y, z)
272 ! real(4) :: y
273 ! real(4) :: z(1_8:neqv_rr(x, y))
284 pure integer(8) function ne_it(x, y)
287 type(t), intent(in) :: y local
291 pure integer(8) function ne_tt(x, y)
293 type(t), intent(in) :: x, y local
297 pure integer(8) function ne_ci(x, y)
299 integer, intent(in) :: y local
303 subroutine s1(x, y, z) argument
305 type(t) :: y local
306 real :: z(x /= y) ! resolves to ne_it
308 subroutine s2(x, y, z) argument
310 type(t) :: y local
311 real :: z(x .ne. y) ! resolves to ne_tt
313 subroutine s3(x, y, z) argument
315 integer :: y local
316 real :: z(x <> y) ! resolves to ne_ci
327 ! pure function ne_it(x, y)
330 ! type(t), intent(in) :: y
335 ! pure function ne_tt(x, y)
338 ! type(t), intent(in) :: y
343 ! pure function ne_ci(x, y)
345 ! integer(4), intent(in) :: y
355 ! subroutine s1(x, y, z)
357 ! type(t) :: y
358 ! real(4) :: z(1_8:ne_it(x, y))
360 ! subroutine s2(x, y, z)
362 ! type(t) :: y
363 ! real(4) :: z(1_8:ne_tt(x, y))
365 ! subroutine s3(x, y, z)
367 ! integer(4) :: y
368 ! real(4) :: z(1_8:ne_ci(x, y))
379 pure integer(8) function concat_12(x, y)
381 character(len=*,kind=2), intent(in) :: y local
383 pure integer(8) function concat_int_real(x, y)
385 real, intent(in) :: y local
389 subroutine s1(x, y, z) argument
391 character(len=*,kind=2) :: y local
392 real :: z(x // y) ! resolves to concat_12
394 subroutine s2(x, y, z) argument
396 real :: y local
397 real :: z(x // y) ! resolves to concat_int_real
407 ! pure function concat_12(x, y)
409 ! character(*, 2), intent(in) :: y
414 ! pure function concat_int_real(x, y)
416 ! real(4), intent(in) :: y
425 ! subroutine s1(x, y, z)
427 ! character(*, 2) :: y
428 ! real(4) :: z(1_8:concat_12(x, y))
430 ! subroutine s2(x, y, z)
432 ! real(4) :: y
433 ! real(4) :: z(1_8:concat_int_real(x, y))
446 interface operator(-) interface
462 subroutine s1(x, y) argument
464 real :: y(+x) ! resolves_to plus_l local
466 subroutine s2(x, y) argument
468 real :: y(-x) ! resolves_to minus_t local
470 subroutine s3(x, y) argument
472 real :: y(.not. x) ! resolves to not_t local
474 subroutine s4(x, y) argument
475 real :: y(.not. x) ! resolves to not_real local
512 ! interface operator(-)
520 ! subroutine s1(x, y)
522 ! real(4) :: y(1_8:plus_l(x))
524 ! subroutine s2(x, y)
526 ! real(4) :: y(1_8:minus_t(x))
528 ! subroutine s3(x, y)
530 ! real(4) :: y(1_8:not_t(x))
532 ! subroutine s4(x, y)
534 ! real(4) :: y(1_8:not_real(x))
541 pure integer(8) function add(x, y)
543 real, intent(in) :: y(:, :, :) local
547 subroutine s1(n, x, y, z, a, b) argument
550 real :: y(4, n) local
552 real :: a(size(x+y)) ! intrinsic +
553 real :: b(y+z) ! resolves to add
560 ! pure function add(x, y)
562 ! real(4), intent(in) :: y(:, :, :)
570 ! subroutine s1(n, x, y, z, a, b)
573 ! real(4) :: y(1_8:4_8, 1_8:n)
575 ! real(4) :: a(1_8:int(int(4_8*size(y,dim=2,kind=8),kind=4),kind=8))
576 ! real(4) :: b(1_8:add(y, z))
587 pure integer(8) function f1(x, y)
589 type(t(4)), intent(in) :: x, y local
591 pure integer(8) function f2(x, y)
593 type(t(8)), intent(in) :: x, y local
597 subroutine s1(x, y, z) argument
598 type(t(4)) :: x, y local
599 real :: z(x + y) ! resolves to f1
601 subroutine s2(x, y, z) argument
602 type(t(8)) :: x, y local
603 real :: z(x + y) ! resolves to f2
614 ! pure function f1(x, y)
617 ! type(t(k=4_4)), intent(in) :: y
622 ! pure function f2(x, y)
625 ! type(t(k=8_4)), intent(in) :: y
634 ! subroutine s1(x, y, z)
636 ! type(t(k=4_4)) :: y
637 ! real(4) :: z(1_8:f1(x, y))
639 ! subroutine s2(x, y, z)
641 ! type(t(k=8_4)) :: y
642 ! real(4) :: z(1_8:f2(x, y))