|
111
|
1 ! { dg-do run }
|
|
|
2 ! PR fortran/34133
|
|
|
3 ! PR fortran/34162
|
|
|
4 !
|
|
|
5 ! Test of using internal bind(C) procedures as
|
|
|
6 ! actual argument. Bind(c) on internal procedures and
|
|
|
7 ! internal procedures are actual argument are
|
|
|
8 ! Fortran 2008 (draft) extension.
|
|
|
9 !
|
|
|
10 module test_mod
|
|
|
11 use iso_c_binding
|
|
|
12 implicit none
|
|
|
13 contains
|
|
|
14 subroutine test_sub(a, arg, res)
|
|
|
15 interface
|
|
|
16 subroutine a(x) bind(C)
|
|
|
17 import
|
|
|
18 integer(c_int), intent(inout) :: x
|
|
|
19 end subroutine a
|
|
|
20 end interface
|
|
|
21 integer(c_int), intent(inout) :: arg
|
|
|
22 integer(c_int), intent(in) :: res
|
|
|
23 call a(arg)
|
|
131
|
24 if(arg /= res) STOP 1
|
|
111
|
25 end subroutine test_sub
|
|
|
26 subroutine test_func(a, arg, res)
|
|
|
27 interface
|
|
|
28 integer(c_int) function a(x) bind(C)
|
|
|
29 import
|
|
|
30 integer(c_int), intent(in) :: x
|
|
|
31 end function a
|
|
|
32 end interface
|
|
|
33 integer(c_int), intent(in) :: arg
|
|
|
34 integer(c_int), intent(in) :: res
|
|
131
|
35 if(a(arg) /= res) STOP 2
|
|
111
|
36 end subroutine test_func
|
|
|
37 end module test_mod
|
|
|
38
|
|
|
39 program main
|
|
|
40 use test_mod
|
|
|
41 implicit none
|
|
|
42 integer :: a
|
|
|
43 a = 33
|
|
|
44 call test_sub (one, a, 7*33)
|
|
|
45 a = 23
|
|
|
46 call test_func(two, a, -123*23)
|
|
|
47 contains
|
|
|
48 subroutine one(x) bind(c)
|
|
|
49 integer(c_int),intent(inout) :: x
|
|
|
50 x = 7*x
|
|
|
51 end subroutine one
|
|
|
52 integer(c_int) function two(y) bind(c)
|
|
|
53 integer(c_int),intent(in) :: y
|
|
|
54 two = -123*y
|
|
|
55 end function two
|
|
|
56 end program main
|
