1! { dg-do run }
2!
3! TS 29113
4! 6.3  Argument association
5! An assumed-rank dummy argument may correspond to an actual argument of
6! any rank. [...] If the actual argument has rank greater than zero, the
7! rank and extents of the dummy argument are assumed from the actual
8! argument, including the lack of a final extent in the case of an
9! assumed-size array. If the actual argument is an array and the dummy
10! argument is allocatable or a pointer, the bounds of the dummy argument
11! are assumed from the actual argument.
12
13program test
14
15  integer, target :: a(3, 4, 5)
16  integer, target :: b(-3:3, 0:4, 2:5, 10:20)
17  integer, pointer :: aa(:,:,:)
18  integer, pointer :: bb(:,:,:,:)
19  aa => a
20  bb => b
21
22  call testit (aa, rank(a), shape(a), lbound(a), ubound(a))
23  call testit (bb, rank(b), shape(b), lbound(b), ubound(b))
24
25contains
26
27  subroutine testit (x, r, s, l, u) bind (c)
28    integer, pointer :: x(..)
29    integer :: r
30    integer :: s(r)
31    integer :: l(r)
32    integer :: u(r)
33
34    ! expect rank to match
35    if (rank (x) .ne. r) stop 101
36
37    ! expect shape to match
38    if (size (shape (x)) .ne. r) stop 102
39    if (any (shape (x) .ne. s))  stop 103
40
41    ! expect lbound and ubound functions to return rank-sized arrays.
42    ! for non-pointer/non-allocatable arrays, bounds are normalized
43    ! to be 1-based.
44    if (size (lbound (x)) .ne. r) stop 104
45    if (any (lbound (x) .ne. l)) stop 105
46
47    if (size (ubound (x)) .ne. r) stop 106
48    if (any (ubound (x) .ne. u)) stop 107
49  end subroutine
50
51end program
52