|
111
|
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
|
|
131
|
70 if (.NOT. NDA .LT. NDB) STOP 1
|
|
111
|
71 END
|
