1! { dg-do run }
2! { dg-additional-sources "fc-descriptor-4-c.c dump-descriptors.c" }
3! { dg-additional-options "-g" }
4!
5! This program tests that pointer and allocatable array arguments are
6! correctly passed by descriptor from Fortran code into C.
7
8program testit
9  use iso_c_binding
10  implicit none
11
12  type, bind (c) :: m
13    real(C_DOUBLE) :: a(3, 3)
14  end type
15
16  interface
17    subroutine ctest (a, b, initp) bind (c)
18      use iso_c_binding
19      import m
20      type(m), allocatable :: a(:)
21      type(m), pointer :: b(:)
22      integer(C_INT), value :: initp
23    end subroutine
24  end interface
25
26  type (m), allocatable, target :: aa(:)
27  type (m), pointer :: bb(:)
28
29  ! Test both before and after allocation/pointer initialization.
30  bb => NULL ()
31  call ctest (aa, bb, 0)
32  allocate (aa(3:7))
33  bb => aa
34  call ctest (aa, bb, 1)
35
36end program
37