1! { dg-do run } 2 3! Type-bound procedures 4! Check basic calls to NOPASS type-bound procedures. 5 6MODULE m 7 IMPLICIT NONE 8 9 TYPE add 10 CONTAINS 11 PROCEDURE, NOPASS :: func => func_add 12 PROCEDURE, NOPASS :: sub => sub_add 13 PROCEDURE, NOPASS :: echo => echo_add 14 END TYPE add 15 16 TYPE mul 17 CONTAINS 18 PROCEDURE, NOPASS :: func => func_mul 19 PROCEDURE, NOPASS :: sub => sub_mul 20 PROCEDURE, NOPASS :: echo => echo_mul 21 END TYPE mul 22 23CONTAINS 24 25 INTEGER FUNCTION func_add (a, b) 26 IMPLICIT NONE 27 INTEGER :: a, b 28 func_add = a + b 29 END FUNCTION func_add 30 31 INTEGER FUNCTION func_mul (a, b) 32 IMPLICIT NONE 33 INTEGER :: a, b 34 func_mul = a * b 35 END FUNCTION func_mul 36 37 SUBROUTINE sub_add (a, b, c) 38 IMPLICIT NONE 39 INTEGER, INTENT(IN) :: a, b 40 INTEGER, INTENT(OUT) :: c 41 c = a + b 42 END SUBROUTINE sub_add 43 44 SUBROUTINE sub_mul (a, b, c) 45 IMPLICIT NONE 46 INTEGER, INTENT(IN) :: a, b 47 INTEGER, INTENT(OUT) :: c 48 c = a * b 49 END SUBROUTINE sub_mul 50 51 SUBROUTINE echo_add () 52 IMPLICIT NONE 53 WRITE (*,*) "Hi from adder!" 54 END SUBROUTINE echo_add 55 56 INTEGER FUNCTION echo_mul () 57 IMPLICIT NONE 58 echo_mul = 5 59 WRITE (*,*) "Hi from muler!" 60 END FUNCTION echo_mul 61 62 ! Do the testing here, in the same module as the type is. 63 SUBROUTINE test () 64 IMPLICIT NONE 65 66 TYPE(add) :: adder 67 TYPE(mul) :: muler 68 69 INTEGER :: x 70 71 IF (adder%func (2, 3) /= 5 .OR. muler%func (2, 3) /= 6) THEN 72 STOP 1 73 END IF 74 75 CALL adder%sub (2, 3, x) 76 IF (x /= 5) THEN 77 STOP 2 78 END IF 79 80 CALL muler%sub (2, 3, x) 81 IF (x /= 6) THEN 82 STOP 3 83 END IF 84 85 ! Check procedures without arguments. 86 CALL adder%echo () 87 x = muler%echo () 88 CALL adder%echo 89 END SUBROUTINE test 90 91END MODULE m 92 93PROGRAM main 94 USE m, ONLY: test 95 CALL test () 96END PROGRAM main 97