diff options
Diffstat (limited to 'gcc-4.9/gcc/testsuite/gfortran.dg/typebound_call_1.f03')
-rw-r--r-- | gcc-4.9/gcc/testsuite/gfortran.dg/typebound_call_1.f03 | 96 |
1 files changed, 96 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/typebound_call_1.f03 b/gcc-4.9/gcc/testsuite/gfortran.dg/typebound_call_1.f03 new file mode 100644 index 000000000..4e7797bdf --- /dev/null +++ b/gcc-4.9/gcc/testsuite/gfortran.dg/typebound_call_1.f03 @@ -0,0 +1,96 @@ +! { 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 + CALL abort () + END IF + + CALL adder%sub (2, 3, x) + IF (x /= 5) THEN + CALL abort () + END IF + + CALL muler%sub (2, 3, x) + IF (x /= 6) THEN + CALL abort () + 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 |