diff options
author | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
---|---|---|
committer | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
commit | 554fd8c5195424bdbcabf5de30fdc183aba391bd (patch) | |
tree | 976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/gfortran.dg/typebound_operator_6.f03 | |
download | cbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.bz2 cbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.xz |
obtained gcc-4.6.4.tar.bz2 from upstream website;upstream
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.
Diffstat (limited to 'gcc/testsuite/gfortran.dg/typebound_operator_6.f03')
-rw-r--r-- | gcc/testsuite/gfortran.dg/typebound_operator_6.f03 | 73 |
1 files changed, 73 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/typebound_operator_6.f03 b/gcc/testsuite/gfortran.dg/typebound_operator_6.f03 new file mode 100644 index 000000000..b2c3ee8b4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/typebound_operator_6.f03 @@ -0,0 +1,73 @@ +! { dg-do run } +! +! PR 45961: [4.6 Regression] [OOP] Problem with polymorphic type-bound operators +! +! Contributed by Mark Rashid <mmrashid@ucdavis.edu> + +MODULE DAT_MOD + + TYPE :: DAT + INTEGER :: NN + CONTAINS + PROCEDURE :: LESS_THAN + GENERIC :: OPERATOR (.LT.) => LESS_THAN + END TYPE DAT + +CONTAINS + + LOGICAL FUNCTION LESS_THAN(A, B) + CLASS (DAT), INTENT (IN) :: A, B + LESS_THAN = (A%NN .LT. B%NN) + END FUNCTION LESS_THAN + +END MODULE DAT_MOD + + +MODULE NODE_MOD + USE DAT_MOD + + TYPE NODE + INTEGER :: KEY + CLASS (DAT), POINTER :: PT + CONTAINS + PROCEDURE :: LST + GENERIC :: OPERATOR (.LT.) => LST + END TYPE NODE + +CONTAINS + + LOGICAL FUNCTION LST(A, B) + CLASS (NODE), INTENT (IN) :: A, B + IF (A%KEY .GT. 0 .AND. B%KEY .GT. 0) THEN + LST = (A%KEY .LT. B%KEY) + ELSE + LST = (A%PT .LT. B%PT) + END IF + END FUNCTION LST + +END MODULE NODE_MOD + + +PROGRAM TEST + USE NODE_MOD + IMPLICIT NONE + + CLASS (DAT), POINTER :: POINTA => NULL(), POINTB => NULL() + CLASS (NODE), POINTER :: NDA => NULL(), NDB => NULL() + + ALLOCATE (DAT :: POINTA) + ALLOCATE (DAT :: POINTB) + ALLOCATE (NODE :: NDA) + ALLOCATE (NODE :: NDB) + + POINTA%NN = 5 + NDA%PT => POINTA + NDA%KEY = 2 + POINTB%NN = 10 + NDB%PT => POINTB + NDB%KEY = 3 + + if (.NOT. NDA .LT. NDB) call abort() +END + +! { dg-final { cleanup-modules "DAT_MOD NODE_MOD" } } |