1! { dg-do run }
2! { dg-options "-fcoarray=single -fcheck=bounds" }
3!
4! Coarray support -- allocatable array coarrays
5!                 -- intrinsic procedures
6! PR fortran/18918
7! PR fortran/43931
8!
9program test
10  implicit none
11  integer,allocatable :: B(:)[:]
12
13  call one()
14  call two()
15  allocate(B(3)[-4:*])
16  call three(3,B,1)
17  call three_a(3,B)
18  call three_b(3,B)
19  call four(B)
20  call five()
21contains
22  subroutine one()
23    integer, allocatable :: a(:)[:,:,:]
24    allocate(a(1)[-4:9,8,4:*])
25
26    if (this_image(a,dim=1) /= -4_8) call abort()
27    if (lcobound  (a,dim=1) /= -4_8) call abort()
28    if (ucobound  (a,dim=1) /=  9_8) call abort()
29
30    if (this_image(a,dim=2) /=  1_8) call abort()
31    if (lcobound  (a,dim=2) /=  1_8) call abort()
32    if (ucobound  (a,dim=2) /=  8_8) call abort()
33
34    if (this_image(a,dim=3) /= 4_8) call abort()
35    if (lcobound  (a,dim=3) /= 4_8) call abort()
36    if (ucobound  (a,dim=3) /= 4_8) call abort()
37
38    if (any(this_image(a) /= [-4_8, 1_8, 4_8])) call abort()
39    if (any(lcobound  (a) /= [-4_8, 1_8, 4_8])) call abort()
40    if (any(ucobound  (a) /= [9_8, 8_8, 4_8])) call abort()
41  end subroutine one
42
43  subroutine two()
44    integer, allocatable :: a(:)[:,:,:]
45    allocate(a(1)[-4:9,8,4:*])
46
47    if (this_image(a,dim=1) /= -4) call abort()
48    if (lcobound  (a,dim=1) /= -4) call abort()
49    if (ucobound  (a,dim=1) /=  9) call abort()
50
51    if (this_image(a,dim=2) /=  1) call abort()
52    if (lcobound  (a,dim=2) /=  1) call abort()
53    if (ucobound  (a,dim=2) /=  8) call abort()
54
55    if (this_image(a,dim=3) /= 4) call abort()
56    if (lcobound  (a,dim=3) /= 4) call abort()
57    if (ucobound  (a,dim=3) /= 4) call abort()
58
59    if (any(this_image(a) /= [-4, 1, 4])) call abort()
60    if (any(lcobound  (a) /= [-4, 1, 4])) call abort()
61    if (any(ucobound  (a) /= [9, 8, 4])) call abort()
62  end subroutine two
63
64  subroutine three(n,A, n2)
65    integer :: n, n2
66    integer :: A(3)[n:*]
67
68    A(1) = 42
69    if (A(1) /= 42) call abort()
70    A(1)[n2] = -42
71    if (A(1)[n2] /= -42) call abort()
72
73    if (this_image(A,dim=1) /= n) call abort()
74    if (lcobound  (A,dim=1) /= n) call abort()
75    if (ucobound  (A,dim=1) /= n) call abort()
76
77    if (any(this_image(A) /= n)) call abort()
78    if (any(lcobound  (A) /= n)) call abort()
79    if (any(ucobound  (A) /= n)) call abort()
80  end subroutine three
81
82  subroutine three_a(n,A)
83    integer :: n
84    integer :: A(3)[n+2:n+5,n-1:*]
85
86    A(1) = 42
87    if (A(1) /= 42) call abort()
88    A(1)[4,n] = -42
89    if (A(1)[4,n] /= -42) call abort()
90
91    if (this_image(A,dim=1) /= n+2) call abort()
92    if (lcobound  (A,dim=1) /= n+2) call abort()
93    if (ucobound  (A,dim=1) /= n+5) call abort()
94
95    if (this_image(A,dim=2) /= n-1) call abort()
96    if (lcobound  (A,dim=2) /= n-1) call abort()
97    if (ucobound  (A,dim=2) /= n-1) call abort()
98
99    if (any(this_image(A) /= [n+2,n-1])) call abort()
100    if (any(lcobound  (A) /= [n+2,n-1])) call abort()
101    if (any(ucobound  (A) /= [n+5,n-1])) call abort()
102  end subroutine three_a
103
104  subroutine three_b(n,A)
105    integer :: n
106    integer :: A(-1:3,0:4,-2:5,-4:7)[n+2:n+5,n-1:*]
107
108    A(-1,0,-2,-4) = 42
109    if (A(-1,0,-2,-4) /= 42) call abort()
110    A(1,0,-2,-4) = 99
111    if (A(1,0,-2,-4) /= 99) call abort()
112
113    if (this_image(A,dim=1) /= n+2) call abort()
114    if (lcobound  (A,dim=1) /= n+2) call abort()
115    if (ucobound  (A,dim=1) /= n+5) call abort()
116
117    if (this_image(A,dim=2) /= n-1) call abort()
118    if (lcobound  (A,dim=2) /= n-1) call abort()
119    if (ucobound  (A,dim=2) /= n-1) call abort()
120
121    if (any(this_image(A) /= [n+2,n-1])) call abort()
122    if (any(lcobound  (A) /= [n+2,n-1])) call abort()
123    if (any(ucobound  (A) /= [n+5,n-1])) call abort()
124  end subroutine three_b
125
126  subroutine four(A)
127    integer, allocatable :: A(:)[:]
128    if (this_image(A,dim=1) /= -4_8) call abort()
129    if (lcobound  (A,dim=1) /= -4_8) call abort()
130    if (ucobound  (A,dim=1) /= -4_8) call abort()
131  end subroutine four
132
133  subroutine five()
134    integer, save :: foo(2)[5:7,4:*]
135    integer :: i
136
137    i = 1
138    foo(1)[5,4] = 42
139    if (foo(1)[5,4] /= 42) call abort()
140    if (this_image(foo,dim=i) /= 5) call abort()
141    if (lcobound(foo,dim=i) /= 5) call abort()
142    if (ucobound(foo,dim=i) /= 7) call abort()
143
144    i = 2
145    if (this_image(foo,dim=i) /= 4) call abort()
146    if (lcobound(foo,dim=i) /= 4) call abort()
147    if (ucobound(foo,dim=i) /= 4) call abort()
148  end subroutine five
149end program test
150