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