1! Reported as pr94070.
2! { dg-do run }
3! { dg-additional-sources "fc-descriptor-6-c.c dump-descriptors.c" }
4! { dg-additional-options "-g" }
5!
6! This program checks that an assumed-size array argument can be passed
7! to a C function via a descriptor, and that the argument descriptor
8! received by C correctly identifies it as assumed-size.
9
10program testit
11  use iso_c_binding
12  implicit none
13
14  ! Assumed-size arrays are not passed by descriptor.  What we'll do
15  ! for this test function is bind an assumed-rank dummy
16  ! to the assumed-size array.  This is supposed to fill in the descriptor
17  ! with information about the array present at the call site.
18  interface
19    subroutine ctest (a) bind (c)
20      use iso_c_binding
21      integer(C_INT) :: a(..)
22    end subroutine
23  end interface
24
25  integer(C_INT), target :: aa(10,5:8)
26
27  ! To get an assumed-size array descriptor, we have to first pass the
28  ! fixed-size array to a Fortran function with an assumed-size dummy,
29  call ftest1 (aa)
30  call ftest2 (aa)
31  call ftest3 (aa)
32
33contains
34  subroutine ftest1 (a)
35    use iso_c_binding
36    integer(C_INT) :: a(10,*)
37    call ctest (a)
38  end subroutine
39  subroutine ftest2 (a)
40    use iso_c_binding
41    integer(C_INT) :: a(10,5:*)
42    call ctest (a)
43  end subroutine
44  subroutine ftest3 (a)
45    use iso_c_binding
46    integer(C_INT) :: a(10,1:*)
47    call ctest (a)
48  end subroutine
49
50end program
51