1! { dg-do run } 2 3! Type-bound procedures 4! Check they can actually be called and run correctly. 5! This also checks for correct module save/restore. 6 7! FIXME: Check that calls to inherited bindings work once CLASS allows that. 8 9MODULE m 10 IMPLICIT NONE 11 12 TYPE mynum 13 REAL :: num_real 14 INTEGER :: num_int 15 CONTAINS 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 24 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 29 END TYPE mynum 30 31CONTAINS 32 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 37 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) 42 END FUNCTION add_int 43 44 TYPE(mynum) FUNCTION add_real (a, b) 45 CLASS(mynum), INTENT(IN) :: a 46 REAL, INTENT(IN) :: b 47 add_real = mynum (a%num_real + b, a%num_int) 48 END FUNCTION add_real 49 50 REAL FUNCTION get_all (me) 51 CLASS(mynum), INTENT(IN) :: me 52 get_all = me%num_real + me%num_int 53 END FUNCTION get_all 54 55 SUBROUTINE assign_real (dest, from) 56 CLASS(mynum), INTENT(INOUT) :: dest 57 REAL, INTENT(IN) :: from 58 dest%num_real = from 59 END SUBROUTINE assign_real 60 61 SUBROUTINE assign_int (dest, from) 62 CLASS(mynum), INTENT(INOUT) :: dest 63 INTEGER, INTENT(IN) :: from 64 dest%num_int = from 65 END SUBROUTINE assign_int 66 67 SUBROUTINE assign_to_real (dest, from) 68 REAL, INTENT(OUT) :: dest 69 CLASS(mynum), INTENT(IN) :: from 70 dest = from%num_real 71 END SUBROUTINE assign_to_real 72 73 SUBROUTINE assign_to_int (dest, from) 74 INTEGER, INTENT(OUT) :: dest 75 CLASS(mynum), INTENT(IN) :: from 76 dest = from%num_int 77 END SUBROUTINE assign_to_int 78 79 ! Test it works basically within the module. 80 SUBROUTINE check_in_module () 81 IMPLICIT NONE 82 TYPE(mynum) :: num 83 84 num = mynum (1.0, 2) 85 num = num + 7 86 IF (num%num_real /= 1.0 .OR. num%num_int /= 9) STOP 1 87 END SUBROUTINE check_in_module 88 89END MODULE m 90 91! Here we see it also works for use-associated operators loaded from a module. 92PROGRAM main 93 USE m, ONLY: mynum, check_in_module 94 IMPLICIT NONE 95 96 TYPE(mynum) :: num1, num2, num3 97 REAL :: real_var 98 INTEGER :: int_var 99 100 CALL check_in_module () 101 102 num1 = mynum (1.0, 2) 103 num2 = mynum (2.0, 3) 104 105 num3 = num1 + num2 106 IF (num3%num_real /= 3.0 .OR. num3%num_int /= 5) STOP 2 107 108 num3 = num1 + 5 109 IF (num3%num_real /= 1.0 .OR. num3%num_int /= 7) STOP 3 110 111 num3 = num1 + (-100.5) 112 IF (num3%num_real /= -99.5 .OR. num3%num_int /= 2) STOP 4 113 114 num3 = 42 115 num3 = -1.2 116 IF (num3%num_real /= -1.2 .OR. num3%num_int /= 42) STOP 5 117 118 real_var = num3 119 int_var = num3 120 IF (real_var /= -1.2 .OR. int_var /= 42) STOP 6 121 122 IF (.GET. num1 /= 3.0) STOP 7 123END PROGRAM main 124