1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
! Check the analyzed form of a defined operator or assignment.
! Type-bound defined assignment
module m1
type :: t
contains
procedure :: b1 => s1
procedure, pass(y) :: b2 => s2
generic :: assignment(=) => b1, b2
end type
contains
subroutine s1(x, y)
class(t), intent(out) :: x
integer, intent(in), value :: y
end
subroutine s2(x, y)
real, intent(out) :: x
class(t), intent(in) :: y
end
subroutine test1(x)
type(t) :: x
real :: a
integer :: j
!CHECK: CALL s1(x,1_4)
x = 1
j = 1
!CHECK: CALL s1(x,j)
x = j ! no parentheses due to VALUE
!CHECK: CALL s2(a,(x))
a = x
end
subroutine test2(x)
class(t) :: x
real :: a
!CHECK: CALL x%b1(1_4)
x = 1
!CHECK: CALL (x)%b2(a)
a = x
end
end
! Type-bound operator
module m2
type :: t2
contains
procedure, pass(x2) :: b2 => f
generic :: operator(+) => b2
end type
contains
integer pure function f(x1, x2)
class(t2), intent(in) :: x1
class(t2), intent(in) :: x2
end
subroutine test2(x, y)
class(t2) :: x
type(t2) :: y
!CHECK: i=f(x,y)
i = x + y
!CHECK: i=x%b2(y)
i = y + x
end
end module
! Non-type-bound assignment and operator
module m3
type t
end type
interface assignment(=)
subroutine s1(x, y)
import
class(t), intent(out) :: x
integer, intent(in) :: y
end
subroutine s2(x, y)
real, intent(out) :: x
class(*), intent(in) :: y
end
subroutine s3(x, y)
integer, intent(out) :: x
class(*), intent(in), value :: y
end
end interface
interface operator(+)
integer function f(x, y)
import
class(t), intent(in) :: x, y
end
end interface
contains
subroutine test(x, y, z)
class(t) :: x, y
class(*), intent(in) :: z
real :: a
!CHECK: CALL s1(x,2_4)
x = 2
!CHECK: i=f(x,y)
i = x + y
!CHECK: CALL s2(a,(z))
a = z
!CHECK: CALL s3(i,z)
i = z
end
end
|
