Subversion Repositories openrisc

! { 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

! { dg-final { cleanup-modules "dat_mod node_mod" } }