aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/gcc/testsuite/gfortran.dg/typebound_call_1.f03
diff options
context:
space:
mode:
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.f0396
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