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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
! { dg-do run }
! Type-bound procedures
! Check they can actually be called and run correctly.
! This also checks for correct module save/restore.
! FIXME: Check that calls to inherited bindings work once CLASS allows that.
MODULE m
IMPLICIT NONE
TYPE mynum
REAL :: num_real
INTEGER :: num_int
CONTAINS
PROCEDURE, PASS, PRIVATE :: add_mynum ! Check that this may be PRIVATE.
PROCEDURE, PASS :: add_int
PROCEDURE, PASS :: add_real
PROCEDURE, PASS :: assign_int
PROCEDURE, PASS :: assign_real
PROCEDURE, PASS(from) :: assign_to_int
PROCEDURE, PASS(from) :: assign_to_real
PROCEDURE, PASS :: get_all
GENERIC :: OPERATOR(+) => add_mynum, add_int, add_real
GENERIC :: OPERATOR(.GET.) => get_all
GENERIC :: ASSIGNMENT(=) => assign_int, assign_real, &
assign_to_int, assign_to_real
END TYPE mynum
CONTAINS
TYPE(mynum) FUNCTION add_mynum (a, b)
CLASS(mynum), INTENT(IN) :: a, b
add_mynum = mynum (a%num_real + b%num_real, a%num_int + b%num_int)
END FUNCTION add_mynum
TYPE(mynum) FUNCTION add_int (a, b)
CLASS(mynum), INTENT(IN) :: a
INTEGER, INTENT(IN) :: b
add_int = mynum (a%num_real, a%num_int + b)
END FUNCTION add_int
TYPE(mynum) FUNCTION add_real (a, b)
CLASS(mynum), INTENT(IN) :: a
REAL, INTENT(IN) :: b
add_real = mynum (a%num_real + b, a%num_int)
END FUNCTION add_real
REAL FUNCTION get_all (me)
CLASS(mynum), INTENT(IN) :: me
get_all = me%num_real + me%num_int
END FUNCTION get_all
SUBROUTINE assign_real (dest, from)
CLASS(mynum), INTENT(INOUT) :: dest
REAL, INTENT(IN) :: from
dest%num_real = from
END SUBROUTINE assign_real
SUBROUTINE assign_int (dest, from)
CLASS(mynum), INTENT(INOUT) :: dest
INTEGER, INTENT(IN) :: from
dest%num_int = from
END SUBROUTINE assign_int
SUBROUTINE assign_to_real (dest, from)
REAL, INTENT(OUT) :: dest
CLASS(mynum), INTENT(IN) :: from
dest = from%num_real
END SUBROUTINE assign_to_real
SUBROUTINE assign_to_int (dest, from)
INTEGER, INTENT(OUT) :: dest
CLASS(mynum), INTENT(IN) :: from
dest = from%num_int
END SUBROUTINE assign_to_int
! Test it works basically within the module.
SUBROUTINE check_in_module ()
IMPLICIT NONE
TYPE(mynum) :: num
num = mynum (1.0, 2)
num = num + 7
IF (num%num_real /= 1.0 .OR. num%num_int /= 9) CALL abort ()
END SUBROUTINE check_in_module
END MODULE m
! Here we see it also works for use-associated operators loaded from a module.
PROGRAM main
USE m, ONLY: mynum, check_in_module
IMPLICIT NONE
TYPE(mynum) :: num1, num2, num3
REAL :: real_var
INTEGER :: int_var
CALL check_in_module ()
num1 = mynum (1.0, 2)
num2 = mynum (2.0, 3)
num3 = num1 + num2
IF (num3%num_real /= 3.0 .OR. num3%num_int /= 5) CALL abort ()
num3 = num1 + 5
IF (num3%num_real /= 1.0 .OR. num3%num_int /= 7) CALL abort ()
num3 = num1 + (-100.5)
IF (num3%num_real /= -99.5 .OR. num3%num_int /= 2) CALL abort ()
num3 = 42
num3 = -1.2
IF (num3%num_real /= -1.2 .OR. num3%num_int /= 42) CALL abort ()
real_var = num3
int_var = num3
IF (real_var /= -1.2 .OR. int_var /= 42) CALL abort ()
IF (.GET. num1 /= 3.0) CALL abort ()
END PROGRAM main
|
