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