1! { dg-do run }
2! { dg-additional-sources "fc-out-descriptor-2-c.c dump-descriptors.c" }
3! { dg-additional-options "-g" }
4!
5! This program checks that passing a fixed-size array as an intent(out)
6! assumed-rank argument to a C function called from Fortran works.
7
8module mm
9  use iso_c_binding
10  type, bind (c) :: m
11    integer(C_INT) :: i, j
12  end type
13
14  integer, parameter :: imax=10, jmax=5
15end module
16
17program testit
18  use iso_c_binding
19  use mm
20  implicit none
21
22  interface
23    subroutine ctest (ii, jj, a) bind (c)
24      use iso_c_binding
25      use mm
26      integer(C_INT), value :: ii, jj
27      type(m), intent(out) :: a(..)
28    end subroutine
29  end interface
30
31  type(m) :: aa(imax,jmax)
32  integer :: i, j
33
34  ! initialize the array to all zeros; ctest will overwrite it.
35  do j = 1, jmax
36    do i = 1, imax
37      aa(i,j)%i = 0
38      aa(i,j)%j = 0
39    end do
40  end do
41
42  call ctest (imax, jmax, aa)
43  call verify (aa)
44
45contains
46subroutine verify (a)
47  use iso_c_binding
48  use mm
49  type(m) :: a(:,:)
50  integer :: i, j
51
52  if (rank (a) .ne. 2) stop 100
53  if (lbound (a, 1) .ne. 1) stop 101
54  if (lbound (a, 2) .ne. 1) stop 102
55  if (ubound (a, 1) .ne. imax) stop 103
56  if (ubound (a, 2) .ne. jmax) stop 104
57
58  do j = 1, jmax
59    do i = 1, imax
60      if (a(i,j)%i .ne. i) stop 201
61      if (a(i,j)%j .ne. j) stop 202
62    end do
63  end do
64end subroutine
65
66end program
67