1! { dg-do run }
2! { dg-additional-sources "cf-descriptor-3-c.c dump-descriptors.c" }
3! { dg-additional-options "-g" }
4!
5! This program checks that building a descriptor for an allocatable
6! or pointer scalar argument in C works and that you can use it to call
7! back into a Fortran function declared to have c binding.
8
9module mm
10  use iso_c_binding
11  type, bind (c) :: m
12    integer(C_INT) :: i, j
13  end type
14
15  integer(C_INT), parameter :: imagic = 42, jmagic = 69
16end module
17
18subroutine ftest (a, b, initp) bind (c, name="ftest")
19  use iso_c_binding
20  use mm
21  type(m), allocatable :: a
22  type(m), pointer :: b
23  integer(C_INT), value :: initp
24
25  if (rank(a) .ne. 0) stop 101
26  if (rank(b) .ne. 0) stop 101
27
28  if (initp .ne. 0 .and. .not. allocated(a))  stop 102
29  if (initp .eq. 0 .and. allocated(a)) stop 103
30  if (initp .ne. 0 .and. .not. associated(b))  stop 104
31  if (initp .eq. 0 .and. associated(b)) stop 105
32
33  if (initp .ne. 0) then
34    if (a%i .ne. imagic) stop 201
35    if (a%j .ne. jmagic) stop 202
36    if (b%i .ne. imagic + 1) stop 203
37    if (b%j .ne. jmagic + 1) stop 204
38  end if
39end subroutine
40
41
42program testit
43  use iso_c_binding
44  use mm
45  implicit none
46
47  interface
48    subroutine ctest (i, j) bind (c)
49      use iso_c_binding
50      integer(C_INT), value :: i, j
51    end subroutine
52  end interface
53
54  ! ctest will call ftest with both an unallocated and allocated argument.
55
56  call ctest (imagic, jmagic)
57
58end program
59