| ! { 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) STOP 1 |
| 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) STOP 2 |
| |
| num3 = num1 + 5 |
| IF (num3%num_real /= 1.0 .OR. num3%num_int /= 7) STOP 3 |
| |
| num3 = num1 + (-100.5) |
| IF (num3%num_real /= -99.5 .OR. num3%num_int /= 2) STOP 4 |
| |
| num3 = 42 |
| num3 = -1.2 |
| IF (num3%num_real /= -1.2 .OR. num3%num_int /= 42) STOP 5 |
| |
| real_var = num3 |
| int_var = num3 |
| IF (real_var /= -1.2 .OR. int_var /= 42) STOP 6 |
| |
| IF (.GET. num1 /= 3.0) STOP 7 |
| END PROGRAM main |