3 ! Type-bound procedures
4 ! Check they can actually be called and run correctly.
5 ! This also checks for correct module save/restore.
7 ! FIXME: Check that calls to inherited bindings work once CLASS allows that.
16 PROCEDURE, PASS, PRIVATE :: add_mynum ! Check that this may be PRIVATE.
17 PROCEDURE, PASS :: add_int
18 PROCEDURE, PASS :: add_real
19 PROCEDURE, PASS :: assign_int
20 PROCEDURE, PASS :: assign_real
21 PROCEDURE, PASS(from) :: assign_to_int
22 PROCEDURE, PASS(from) :: assign_to_real
23 PROCEDURE, PASS :: get_all
25 GENERIC :: OPERATOR(+) => add_mynum, add_int, add_real
26 GENERIC :: OPERATOR(.GET.) => get_all
27 GENERIC :: ASSIGNMENT(=) => assign_int, assign_real, &
28 assign_to_int, assign_to_real
33 TYPE(mynum) FUNCTION add_mynum (a, b)
34 CLASS(mynum), INTENT(IN) :: a, b
35 add_mynum = mynum (a%num_real + b%num_real, a%num_int + b%num_int)
36 END FUNCTION add_mynum
38 TYPE(mynum) FUNCTION add_int (a, b)
39 CLASS(mynum), INTENT(IN) :: a
40 INTEGER, INTENT(IN) :: b
41 add_int = mynum (a%num_real, a%num_int + b)
44 TYPE(mynum) FUNCTION add_real (a, b)
45 CLASS(mynum), INTENT(IN) :: a
47 add_real = mynum (a%num_real + b, a%num_int)
50 REAL FUNCTION get_all (me)
51 CLASS(mynum), INTENT(IN) :: me
52 get_all = me%num_real + me%num_int
55 SUBROUTINE assign_real (dest, from)
56 CLASS(mynum), INTENT(INOUT) :: dest
57 REAL, INTENT(IN) :: from
59 END SUBROUTINE assign_real
61 SUBROUTINE assign_int (dest, from)
62 CLASS(mynum), INTENT(INOUT) :: dest
63 INTEGER, INTENT(IN) :: from
65 END SUBROUTINE assign_int
67 SUBROUTINE assign_to_real (dest, from)
68 REAL, INTENT(OUT) :: dest
69 CLASS(mynum), INTENT(IN) :: from
71 END SUBROUTINE assign_to_real
73 SUBROUTINE assign_to_int (dest, from)
74 INTEGER, INTENT(OUT) :: dest
75 CLASS(mynum), INTENT(IN) :: from
77 END SUBROUTINE assign_to_int
79 ! Test it works basically within the module.
80 SUBROUTINE check_in_module ()
86 IF (num%num_real /= 1.0 .OR. num%num_int /= 9) STOP 1
87 END SUBROUTINE check_in_module
91 ! Here we see it also works for use-associated operators loaded from a module.
93 USE m, ONLY: mynum, check_in_module
96 TYPE(mynum) :: num1, num2, num3
100 CALL check_in_module ()
102 num1 = mynum (1.0, 2)
103 num2 = mynum (2.0, 3)
106 IF (num3%num_real /= 3.0 .OR. num3%num_int /= 5) STOP 2
109 IF (num3%num_real /= 1.0 .OR. num3%num_int /= 7) STOP 3
111 num3 = num1 + (-100.5)
112 IF (num3%num_real /= -99.5 .OR. num3%num_int /= 2) STOP 4
116 IF (num3%num_real /= -1.2 .OR. num3%num_int /= 42) STOP 5
120 IF (real_var /= -1.2 .OR. int_var /= 42) STOP 6
122 IF (.GET. num1 /= 3.0) STOP 7