1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
|
! { dg-do run }
! { dg-additional-sources "cf-descriptor-1-c.c dump-descriptors.c" }
!
! This program checks that building a descriptor for a fixed-size array
! in C works and that you can use it to call back into a Fortran function
! declared to have c binding, as an assumed-shape argument.
module mm
use iso_c_binding
type, bind (c) :: m
integer(C_INT) :: i, j
end type
integer, parameter :: imax=10, jmax=5
end module
subroutine ftest (a, b) bind (c, name="ftest")
use iso_c_binding
use mm
type(m) :: a(:,:), b(:,:)
integer :: i, j
if (size (a,1) .ne. imax) stop 101
if (size (a,2) .ne. jmax) stop 102
if (size (b,1) .ne. jmax) stop 103
if (size (b,2) .ne. imax) stop 104
do j = 1, jmax
do i = 1, imax
if (a(i,j)%i .ne. i) stop 201
if (a(i,j)%j .ne. j) stop 202
if (b(j,i)%i .ne. i) stop 203
if (b(j,i)%j .ne. j) stop 204
end do
end do
end subroutine
program testit
use iso_c_binding
use mm
implicit none
interface
subroutine ctest (a) bind (c)
use iso_c_binding
use mm
type(m) :: a(:,:)
end subroutine
end interface
type(m) :: aa(imax,jmax)
integer :: i, j
do j = 1, jmax
do i = 1, imax
aa(i,j)%i = i
aa(i,j)%j = j
end do
end do
! Pass the initialized array to a C function ctest, which will generate its
! transpose and call ftest with it.
call ctest (aa)
end program
|
