blob: 02bd01a948a903c8b458b0af886384b3db47c0d2 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
! { dg-do run }
!
! PR 45961: [4.6 Regression] [OOP] Problem with polymorphic type-bound operators
!
! Contributed by Mark Rashid <mmrashid@ucdavis.edu>
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
|
