gcc/testsuite/gfortran.dg/overload_1.f90

   1 ! { dg-do run }
   2 ! tests that operator overloading works correctly for operators with
   3 ! different spellings
   4 module 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
  61 contains
  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
 145 end module m
 146
 147
 148 program main
 149   call checkt
 150   call checku
 151
 152 contains
 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)) STOP 1
 164     if (any (r1.neqv. &
 165          (/ .false.,.true.,.true., .true., .false.,.false. /) )) STOP 1
 166   end subroutine checkt
 167
 168   subroutine checku
 169     use m
 170
 171     type (u) :: a, b
 172     logical :: r1(6), r2(6)
 173     a%i = 0; b%i = 1
 174
 175     r1 = (/ a == b, a /= b, a <  b, a <= b, a >  b, a >= b /)
 176     r2 = (/ a.eq.b, a.ne.b, a.lt.b, a.le.b, a.gt.b, a.ge.b /)
 177     if (any (r1.neqv.r2)) STOP 2
 178     if (any (r1.neqv. &
 179          (/ .false.,.true.,.true., .true., .false.,.false. /) )) STOP 2
 180   end subroutine checku
 181 end program main