summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/typebound_operator_6.f03
diff options
context:
space:
mode:
authorupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
committerupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
commit554fd8c5195424bdbcabf5de30fdc183aba391bd (patch)
tree976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/gfortran.dg/typebound_operator_6.f03
downloadcbb-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.f0373
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" } }