gcc/testsuite/gfortran.dg/typebound_operator_6.f03

   1 ! { dg-do run }
   2 !
   3 ! PR 45961: [4.6 Regression] [OOP] Problem with polymorphic type-bound operators
   4 !
   5 ! Contributed by Mark Rashid <mmrashid@ucdavis.edu>
   6
   7 MODULE DAT_MOD
   8
   9   TYPE :: DAT
  10     INTEGER :: NN
  11   CONTAINS
  12     PROCEDURE :: LESS_THAN
  13     GENERIC :: OPERATOR (.LT.) => LESS_THAN
  14   END TYPE DAT
  15
  16 CONTAINS
  17
  18   LOGICAL FUNCTION LESS_THAN(A, B)
  19     CLASS (DAT), INTENT (IN) :: A, B
  20     LESS_THAN = (A%NN .LT. B%NN)
  21   END FUNCTION LESS_THAN
  22
  23 END MODULE DAT_MOD
  24
  25
  26 MODULE NODE_MOD
  27   USE DAT_MOD
  28
  29   TYPE NODE
  30     INTEGER :: KEY
  31     CLASS (DAT), POINTER :: PT
  32   CONTAINS
  33     PROCEDURE :: LST
  34     GENERIC :: OPERATOR (.LT.) => LST
  35   END TYPE NODE
  36
  37 CONTAINS
  38
  39   LOGICAL FUNCTION LST(A, B)
  40     CLASS (NODE), INTENT (IN) :: A, B
  41     IF (A%KEY .GT. 0 .AND. B%KEY .GT. 0) THEN
  42       LST = (A%KEY .LT. B%KEY)
  43     ELSE
  44       LST = (A%PT .LT. B%PT)
  45     END IF
  46   END FUNCTION LST
  47
  48 END MODULE NODE_MOD
  49
  50
  51 PROGRAM TEST
  52   USE NODE_MOD
  53   IMPLICIT NONE
  54
  55   CLASS (DAT), POINTER :: POINTA => NULL(), POINTB => NULL()
  56   CLASS (NODE), POINTER :: NDA => NULL(), NDB => NULL()
  57
  58   ALLOCATE (DAT :: POINTA)
  59   ALLOCATE (DAT :: POINTB)
  60   ALLOCATE (NODE :: NDA)
  61   ALLOCATE (NODE :: NDB)
  62
  63   POINTA%NN = 5
  64   NDA%PT => POINTA
  65   NDA%KEY = 2
  66   POINTB%NN = 10
  67   NDB%PT => POINTB
  68   NDB%KEY = 3
  69
  70   if (.NOT. NDA .LT. NDB) STOP 1
  71 END