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