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
7MODULE 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
16CONTAINS
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
23END MODULE DAT_MOD
24
25
26MODULE 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
37CONTAINS
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
48END MODULE NODE_MOD
49
50
51PROGRAM 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) call abort()
71END
72