1! { dg-do run }
2! { dg-additional-sources note-5-4-c.c }
3!
4! TS 29113
5! NOTE 5.4
6! Assumed rank is an attribute of a Fortran dummy argument. When a C
7! function is invoked with an actual argument that corresponds to an
8! assumed-rank dummy argument in a Fortran interface for that C function,
9! the corresponding formal parameter is the address of a descriptor of
10! type CFI_cdesc_t (8.7). The rank member of the descriptor provides the
11! rank of the actual argument. The C function should therefore be able
12! to handle any rank. On each invocation, the rank is available to it.
13
14program test
15
16  interface
17    function test_rank (a) bind (c, name="test_rank")
18      integer :: test_rank
19      integer :: a(..)
20    end function
21  end interface
22
23  integer ::  scalar, array_1d(10), array_2d(3, 3)
24
25  call testit (scalar, array_1d, array_2d)
26
27contains
28
29  subroutine testit (a0, a1, a2)
30    integer :: a0(..), a1(..), a2(..)
31
32    integer, target :: b0, b1(10), b2(3, 3)
33    integer, allocatable :: c0, c1(:), c2(:,:)
34    integer, pointer :: d0, d1(:), d2(:,:)
35
36    ! array descriptor passed from caller through testit to test_rank
37    if (test_rank (a0) .ne. 0) stop 100
38    if (test_rank (a1) .ne. 1) stop 101
39    if (test_rank (a2) .ne. 2) stop 102
40
41    ! array descriptor created locally here, fixed size
42    if (test_rank (b0) .ne. 0) stop 200
43    if (test_rank (b1) .ne. 1) stop 201
44    if (test_rank (b2) .ne. 2) stop 202
45
46    ! allocatables
47    allocate (c0)
48    allocate (c1 (10))
49    allocate (c2 (3, 3))
50    if (test_rank (c0) .ne. 0) stop 300
51    if (test_rank (c1) .ne. 1) stop 301
52    if (test_rank (c2) .ne. 2) stop 302
53
54    ! pointers
55    d0 => b0
56    d1 => b1
57    d2 => b2
58    if (test_rank (d0) .ne. 0) stop 400
59    if (test_rank (d1) .ne. 1) stop 401
60    if (test_rank (d2) .ne. 2) stop 402
61
62  end subroutine
63end program
64