From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository. --- gcc/testsuite/gfortran.dg/overload_1.f90 | 184 +++++++++++++++++++++++++++++++ 1 file changed, 184 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/overload_1.f90 (limited to 'gcc/testsuite/gfortran.dg/overload_1.f90') diff --git a/gcc/testsuite/gfortran.dg/overload_1.f90 b/gcc/testsuite/gfortran.dg/overload_1.f90 new file mode 100644 index 000000000..fc38a6c90 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/overload_1.f90 @@ -0,0 +1,184 @@ +! { 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" } } -- cgit v1.2.3