1! { dg-do run }
2! { dg-additional-sources assumed_rank_1_c.c }
3!
4! PR fortran/48820
5!
6! Assumed-rank tests
7!
8
9implicit none
10
11interface
12  subroutine check_value(b, n, val)
13    integer :: b(..)
14    integer, value :: n
15    integer :: val(n)
16  end subroutine
17end interface
18
19integer, target :: x(2:5,4:7), y(-4:4)
20integer, allocatable, target :: z(:,:,:,:)
21integer, allocatable :: val(:)
22integer :: i
23
24allocate(z(1:4, -2:5, 4, 10:11))
25
26if (rank(x) /= 2) call abort ()
27val = [(2*i+3, i = 1, size(x))]
28x = reshape (val, shape(x))
29call foo(x, rank(x), lbound(x), ubound(x), val)
30call foo2(x, rank(x), lbound(x), ubound(x), val)
31call bar(x,x,.true.)
32call bar(x,prsnt=.false.)
33
34if (rank(y) /= 1) call abort ()
35val = [(2*i+7, i = 1, size(y))]
36y = reshape (val, shape(y))
37call foo(y, rank(y), lbound(y), ubound(y), val)
38call foo2(y, rank(y), lbound(y), ubound(y), val)
39call bar(y,y,.true.)
40call bar(y,prsnt=.false.)
41
42if (rank(z) /= 4) call abort ()
43val = [(2*i+5, i = 1, size(z))]
44z(:,:,:,:) = reshape (val, shape(z))
45call foo(z, rank(z), lbound(z), ubound(z), val)
46call foo(z, rank(z), lbound(z), ubound(z), val)
47call foo2(z, rank(z), lbound(z), ubound(z), val)
48call bar(z,z,.true.)
49call bar(z,prsnt=.false.)
50
51contains
52  subroutine bar(a,b, prsnt)
53    integer, pointer, optional, intent(in) :: a(..),b(..)
54    logical, value :: prsnt
55    if (.not. associated(a)) call abort()
56    if (present(b)) then
57       ! The following is not valid.
58       ! Technically, it could be allowed and might be in Fortran 2015:
59       ! if (.not. associated(a,b)) call abort()
60    else
61      if (.not. associated(a)) call abort()
62    end if
63    if (.not. present(a)) call abort()
64    if (prsnt .neqv. present(b)) call abort()
65  end subroutine
66
67  ! POINTER argument - bounds as specified before
68  subroutine foo(a, rnk, low, high, val)
69    integer,pointer, intent(in) :: a(..)
70    integer, value :: rnk
71    integer, intent(in) :: low(:), high(:), val(:)
72    integer :: i
73
74
75
76    if (rank(a) /= rnk) call abort()
77    if (size(low) /= rnk .or. size(high) /= rnk) call abort()
78    if (size(a) /= product (high - low +1)) call abort()
79
80    if (rnk > 0) then
81      if (low(1) /= lbound(a,1)) call abort()
82      if (high(1) /= ubound(a,1)) call abort()
83      if (size (a,1) /= high(1)-low(1)+1) call abort()
84    end if
85
86    do i = 1, rnk
87      if (low(i) /= lbound(a,i)) call abort()
88      if (high(i) /= ubound(a,i)) call abort()
89      if (size (a,i) /= high(i)-low(i)+1) call abort()
90    end do
91    call check_value (a, rnk, val)
92    call foo2(a, rnk, low, high, val)
93  end subroutine
94
95  ! Non-pointer, non-allocatable bounds. lbound == 1
96  subroutine foo2(a, rnk, low, high, val)
97    integer, intent(in) :: a(..)
98    integer, value :: rnk
99    integer, intent(in) :: low(:), high(:), val(:)
100    integer :: i
101
102    if (rank(a) /= rnk) call abort()
103    if (size(low) /= rnk .or. size(high) /= rnk) call abort()
104    if (size(a) /= product (high - low +1)) call abort()
105
106    if (rnk > 0) then
107      if (1 /= lbound(a,1)) call abort()
108      if (high(1)-low(1)+1 /= ubound(a,1)) call abort()
109      if (size (a,1) /= high(1)-low(1)+1) call abort()
110    end if
111
112    do i = 1, rnk
113      if (1 /= lbound(a,i)) call abort()
114      if (high(i)-low(i)+1 /= ubound(a,i)) call abort()
115      if (size (a,i) /= high(i)-low(i)+1) call abort()
116    end do
117    call check_value (a, rnk, val)
118  end subroutine foo2
119
120  ! ALLOCATABLE argument - bounds as specified before
121  subroutine foo3 (a, rnk, low, high, val)
122    integer, allocatable, intent(in), target :: a(..)
123    integer, value :: rnk
124    integer, intent(in) :: low(:), high(:), val(:)
125    integer :: i
126
127    if (rank(a) /= rnk) call abort()
128    if (size(low) /= rnk .or. size(high) /= rnk) call abort()
129    if (size(a) /= product (high - low +1)) call abort()
130
131    if (rnk > 0) then
132      if (low(1) /= lbound(a,1)) call abort()
133      if (high(1) /= ubound(a,1)) call abort()
134      if (size (a,1) /= high(1)-low(1)+1) call abort()
135    end if
136
137    do i = 1, rnk
138      if (low(i) /= lbound(a,i)) call abort()
139      if (high(i) /= ubound(a,i)) call abort()
140      if (size (a,i) /= high(i)-low(i)+1) call abort()
141    end do
142    call check_value (a, rnk, val)
143    call foo(a, rnk, low, high, val)
144  end subroutine
145end
146