URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [overload_1.f90] - Blame information for rev 694

Details | Compare with Previous | View Log


! { dg-do run }
! tests that operator overloading works correctly for operators with
! different spellings
module m
  type t
     integer :: i
  end type t
 
  interface operator (==)
     module procedure teq
  end interface
 
  interface operator (/=)
     module procedure tne
  end interface
 
  interface operator (>)
     module procedure tgt
  end interface
 
  interface operator (>=)
     module procedure tge
  end interface
 
  interface operator (<)
     module procedure tlt
  end interface
 
  interface operator (<=)
     module procedure tle
  end interface
 
  type u
     integer :: i
  end type u
 
  interface operator (.eq.)
     module procedure ueq
  end interface
 
  interface operator (.ne.)
     module procedure une
  end interface
 
  interface operator (.gt.)
     module procedure ugt
  end interface
 
  interface operator (.ge.)
     module procedure uge
  end interface
 
  interface operator (.lt.)
     module procedure ult
  end interface
 
  interface operator (.le.)
     module procedure ule
  end interface
 
contains
  function teq (a, b)
    logical teq
    type (t), intent (in) :: a, b
 
    teq = a%i == b%i
  end function teq
 
  function tne (a, b)
    logical tne
    type (t), intent (in) :: a, b
 
    tne = a%i /= b%i
  end function tne
 
  function tgt (a, b)
    logical tgt
    type (t), intent (in) :: a, b
 
    tgt = a%i > b%i
  end function tgt
 
  function tge (a, b)
    logical tge
    type (t), intent (in) :: a, b
 
    tge = a%i >= b%i
  end function tge
 
  function tlt (a, b)
    logical tlt
    type (t), intent (in) :: a, b
 
    tlt = a%i < b%i
  end function tlt
 
  function tle (a, b)
    logical tle
    type (t), intent (in) :: a, b
 
    tle = a%i <= b%i
  end function tle
 
  function ueq (a, b)
    logical ueq
    type (u), intent (in) :: a, b
 
    ueq = a%i == b%i
  end function ueq
 
  function une (a, b)
    logical une
    type (u), intent (in) :: a, b
 
    une = a%i /= b%i
  end function une
 
  function ugt (a, b)
    logical ugt
    type (u), intent (in) :: a, b
 
    ugt = a%i > b%i
  end function ugt
 
  function uge (a, b)
    logical uge
    type (u), intent (in) :: a, b
 
    uge = a%i >= b%i
  end function uge
 
  function ult (a, b)
    logical ult
    type (u), intent (in) :: a, b
 
    ult = a%i < b%i
  end function ult
 
  function ule (a, b)
    logical ule
    type (u), intent (in) :: a, b
 
    ule = a%i <= b%i
  end function ule
end module m
 
 
program main
  call checkt
  call checku
 
contains
 
  subroutine checkt
    use m
 
    type (t) :: a, b
    logical :: r1(6), r2(6)
    a%i = 0; b%i = 1
 
    r1 = (/ a == b, a /= b, a <  b, a <= b, a >  b, a >= b /)
    r2 = (/ a.eq.b, a.ne.b, a.lt.b, a.le.b, a.gt.b, a.ge.b /)
    if (any (r1.neqv.r2)) call abort
    if (any (r1.neqv. &
         (/ .false.,.true.,.true., .true., .false.,.false. /) )) call&
         & abort
  end subroutine checkt
 
  subroutine checku
    use m
 
    type (u) :: a, b
    logical :: r1(6), r2(6)
    a%i = 0; b%i = 1
 
    r1 = (/ a == b, a /= b, a <  b, a <= b, a >  b, a >= b /)
    r2 = (/ a.eq.b, a.ne.b, a.lt.b, a.le.b, a.gt.b, a.ge.b /)
    if (any (r1.neqv.r2)) call abort
    if (any (r1.neqv. &
         (/ .false.,.true.,.true., .true., .false.,.false. /) )) call&
         & abort
  end subroutine checku
end program main
! { dg-final { cleanup-modules "m" } }

Line No.	Rev	Author	Line
1	694	jeremybenn	`! { 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)) 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`
183			`end program main`
184			`! { dg-final { cleanup-modules "m" } }`

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [overload_1.f90] - Blame information for rev 694