1! { dg-do run }
2! tests that operator overloading works correctly for operators with
3! different spellings
4module m
5  type t
6     integer :: i
7  end type t
8
9  interface operator (==)
10     module procedure teq
11  end interface
12
13  interface operator (/=)
14     module procedure tne
15  end interface
16
17  interface operator (>)
18     module procedure tgt
19  end interface
20
21  interface operator (>=)
22     module procedure tge
23  end interface
24
25  interface operator (<)
26     module procedure tlt
27  end interface
28
29  interface operator (<=)
30     module procedure tle
31  end interface
32
33  type u
34     integer :: i
35  end type u
36
37  interface operator (.eq.)
38     module procedure ueq
39  end interface
40
41  interface operator (.ne.)
42     module procedure une
43  end interface
44
45  interface operator (.gt.)
46     module procedure ugt
47  end interface
48
49  interface operator (.ge.)
50     module procedure uge
51  end interface
52
53  interface operator (.lt.)
54     module procedure ult
55  end interface
56
57  interface operator (.le.)
58     module procedure ule
59  end interface
60
61contains
62  function teq (a, b)
63    logical teq
64    type (t), intent (in) :: a, b
65
66    teq = a%i == b%i
67  end function teq
68
69  function tne (a, b)
70    logical tne
71    type (t), intent (in) :: a, b
72
73    tne = a%i /= b%i
74  end function tne
75
76  function tgt (a, b)
77    logical tgt
78    type (t), intent (in) :: a, b
79
80    tgt = a%i > b%i
81  end function tgt
82
83  function tge (a, b)
84    logical tge
85    type (t), intent (in) :: a, b
86
87    tge = a%i >= b%i
88  end function tge
89
90  function tlt (a, b)
91    logical tlt
92    type (t), intent (in) :: a, b
93
94    tlt = a%i < b%i
95  end function tlt
96
97  function tle (a, b)
98    logical tle
99    type (t), intent (in) :: a, b
100
101    tle = a%i <= b%i
102  end function tle
103
104  function ueq (a, b)
105    logical ueq
106    type (u), intent (in) :: a, b
107
108    ueq = a%i == b%i
109  end function ueq
110
111  function une (a, b)
112    logical une
113    type (u), intent (in) :: a, b
114
115    une = a%i /= b%i
116  end function une
117
118  function ugt (a, b)
119    logical ugt
120    type (u), intent (in) :: a, b
121
122    ugt = a%i > b%i
123  end function ugt
124
125  function uge (a, b)
126    logical uge
127    type (u), intent (in) :: a, b
128
129    uge = a%i >= b%i
130  end function uge
131
132  function ult (a, b)
133    logical ult
134    type (u), intent (in) :: a, b
135
136    ult = a%i < b%i
137  end function ult
138
139  function ule (a, b)
140    logical ule
141    type (u), intent (in) :: a, b
142
143    ule = a%i <= b%i
144  end function ule
145end module m
146
147
148program main
149  call checkt
150  call checku
151
152contains
153
154  subroutine checkt
155    use m
156
157    type (t) :: a, b
158    logical :: r1(6), r2(6)
159    a%i = 0; b%i = 1
160
161    r1 = (/ a == b, a /= b, a <  b, a <= b, a >  b, a >= b /)
162    r2 = (/ a.eq.b, a.ne.b, a.lt.b, a.le.b, a.gt.b, a.ge.b /)
163    if (any (r1.neqv.r2)) call abort
164    if (any (r1.neqv. &
165         (/ .false.,.true.,.true., .true., .false.,.false. /) )) call&
166         & abort
167  end subroutine checkt
168
169  subroutine checku
170    use m
171
172    type (u) :: a, b
173    logical :: r1(6), r2(6)
174    a%i = 0; b%i = 1
175
176    r1 = (/ a == b, a /= b, a <  b, a <= b, a >  b, a >= b /)
177    r2 = (/ a.eq.b, a.ne.b, a.lt.b, a.le.b, a.gt.b, a.ge.b /)
178    if (any (r1.neqv.r2)) call abort
179    if (any (r1.neqv. &
180         (/ .false.,.true.,.true., .true., .false.,.false. /) )) call&
181         & abort
182  end subroutine checku
183end program main
184