blob: 02bd01a948a903c8b458b0af886384b3db47c0d2 [file] [log] [blame]
 ! { dg-do run } ! ! PR 45961: [4.6 Regression] [OOP] Problem with polymorphic type-bound operators ! ! Contributed by Mark Rashid 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