| ! { dg-do run } |
| |
| ! Type-bound procedures |
| ! Check basic calls to NOPASS type-bound procedures. |
| |
| MODULE m |
| IMPLICIT NONE |
| |
| TYPE add |
| CONTAINS |
| PROCEDURE, NOPASS :: func => func_add |
| PROCEDURE, NOPASS :: sub => sub_add |
| PROCEDURE, NOPASS :: echo => echo_add |
| END TYPE add |
| |
| TYPE mul |
| CONTAINS |
| PROCEDURE, NOPASS :: func => func_mul |
| PROCEDURE, NOPASS :: sub => sub_mul |
| PROCEDURE, NOPASS :: echo => echo_mul |
| END TYPE mul |
| |
| CONTAINS |
| |
| INTEGER FUNCTION func_add (a, b) |
| IMPLICIT NONE |
| INTEGER :: a, b |
| func_add = a + b |
| END FUNCTION func_add |
| |
| INTEGER FUNCTION func_mul (a, b) |
| IMPLICIT NONE |
| INTEGER :: a, b |
| func_mul = a * b |
| END FUNCTION func_mul |
| |
| SUBROUTINE sub_add (a, b, c) |
| IMPLICIT NONE |
| INTEGER, INTENT(IN) :: a, b |
| INTEGER, INTENT(OUT) :: c |
| c = a + b |
| END SUBROUTINE sub_add |
| |
| SUBROUTINE sub_mul (a, b, c) |
| IMPLICIT NONE |
| INTEGER, INTENT(IN) :: a, b |
| INTEGER, INTENT(OUT) :: c |
| c = a * b |
| END SUBROUTINE sub_mul |
| |
| SUBROUTINE echo_add () |
| IMPLICIT NONE |
| WRITE (*,*) "Hi from adder!" |
| END SUBROUTINE echo_add |
| |
| INTEGER FUNCTION echo_mul () |
| IMPLICIT NONE |
| echo_mul = 5 |
| WRITE (*,*) "Hi from muler!" |
| END FUNCTION echo_mul |
| |
| ! Do the testing here, in the same module as the type is. |
| SUBROUTINE test () |
| IMPLICIT NONE |
| |
| TYPE(add) :: adder |
| TYPE(mul) :: muler |
| |
| INTEGER :: x |
| |
| IF (adder%func (2, 3) /= 5 .OR. muler%func (2, 3) /= 6) THEN |
| STOP 1 |
| END IF |
| |
| CALL adder%sub (2, 3, x) |
| IF (x /= 5) THEN |
| STOP 2 |
| END IF |
| |
| CALL muler%sub (2, 3, x) |
| IF (x /= 6) THEN |
| STOP 3 |
| END IF |
| |
| ! Check procedures without arguments. |
| CALL adder%echo () |
| x = muler%echo () |
| CALL adder%echo |
| END SUBROUTINE test |
| |
| END MODULE m |
| |
| PROGRAM main |
| USE m, ONLY: test |
| CALL test () |
| END PROGRAM main |