! { dg-do run } ! { dg-options "-fcoarray=single -fcheck=bounds" } ! ! Coarray support -- allocatable array coarrays ! -- intrinsic procedures ! PR fortran/18918 ! PR fortran/43931 ! program test implicit none integer,allocatable :: B(:)[:] call one() call two() allocate(B(3)[-4:*]) call three(3,B,1) call three_a(3,B) call three_b(3,B) call four(B) call five() contains subroutine one() integer, allocatable :: a(:)[:,:,:] allocate(a(1)[-4:9,8,4:*]) if (this_image(a,dim=1) /= -4_8) call abort() if (lcobound (a,dim=1) /= -4_8) call abort() if (ucobound (a,dim=1) /= 9_8) call abort() if (this_image(a,dim=2) /= 1_8) call abort() if (lcobound (a,dim=2) /= 1_8) call abort() if (ucobound (a,dim=2) /= 8_8) call abort() if (this_image(a,dim=3) /= 4_8) call abort() if (lcobound (a,dim=3) /= 4_8) call abort() if (ucobound (a,dim=3) /= 4_8) call abort() if (any(this_image(a) /= [-4_8, 1_8, 4_8])) call abort() if (any(lcobound (a) /= [-4_8, 1_8, 4_8])) call abort() if (any(ucobound (a) /= [9_8, 8_8, 4_8])) call abort() end subroutine one subroutine two() integer, allocatable :: a(:)[:,:,:] allocate(a(1)[-4:9,8,4:*]) if (this_image(a,dim=1) /= -4) call abort() if (lcobound (a,dim=1) /= -4) call abort() if (ucobound (a,dim=1) /= 9) call abort() if (this_image(a,dim=2) /= 1) call abort() if (lcobound (a,dim=2) /= 1) call abort() if (ucobound (a,dim=2) /= 8) call abort() if (this_image(a,dim=3) /= 4) call abort() if (lcobound (a,dim=3) /= 4) call abort() if (ucobound (a,dim=3) /= 4) call abort() if (any(this_image(a) /= [-4, 1, 4])) call abort() if (any(lcobound (a) /= [-4, 1, 4])) call abort() if (any(ucobound (a) /= [9, 8, 4])) call abort() end subroutine two subroutine three(n,A, n2) integer :: n, n2 integer :: A(3)[n:*] A(1) = 42 if (A(1) /= 42) call abort() A(1)[n2] = -42 if (A(1)[n2] /= -42) call abort() if (this_image(A,dim=1) /= n) call abort() if (lcobound (A,dim=1) /= n) call abort() if (ucobound (A,dim=1) /= n) call abort() if (any(this_image(A) /= n)) call abort() if (any(lcobound (A) /= n)) call abort() if (any(ucobound (A) /= n)) call abort() end subroutine three subroutine three_a(n,A) integer :: n integer :: A(3)[n+2:n+5,n-1:*] A(1) = 42 if (A(1) /= 42) call abort() A(1)[4,n] = -42 if (A(1)[4,n] /= -42) call abort() if (this_image(A,dim=1) /= n+2) call abort() if (lcobound (A,dim=1) /= n+2) call abort() if (ucobound (A,dim=1) /= n+5) call abort() if (this_image(A,dim=2) /= n-1) call abort() if (lcobound (A,dim=2) /= n-1) call abort() if (ucobound (A,dim=2) /= n-1) call abort() if (any(this_image(A) /= [n+2,n-1])) call abort() if (any(lcobound (A) /= [n+2,n-1])) call abort() if (any(ucobound (A) /= [n+5,n-1])) call abort() end subroutine three_a subroutine three_b(n,A) integer :: n integer :: A(-1:3,0:4,-2:5,-4:7)[n+2:n+5,n-1:*] A(-1,0,-2,-4) = 42 if (A(-1,0,-2,-4) /= 42) call abort() A(1,0,-2,-4) = 99 if (A(1,0,-2,-4) /= 99) call abort() if (this_image(A,dim=1) /= n+2) call abort() if (lcobound (A,dim=1) /= n+2) call abort() if (ucobound (A,dim=1) /= n+5) call abort() if (this_image(A,dim=2) /= n-1) call abort() if (lcobound (A,dim=2) /= n-1) call abort() if (ucobound (A,dim=2) /= n-1) call abort() if (any(this_image(A) /= [n+2,n-1])) call abort() if (any(lcobound (A) /= [n+2,n-1])) call abort() if (any(ucobound (A) /= [n+5,n-1])) call abort() end subroutine three_b subroutine four(A) integer, allocatable :: A(:)[:] if (this_image(A,dim=1) /= -4_8) call abort() if (lcobound (A,dim=1) /= -4_8) call abort() if (ucobound (A,dim=1) /= -4_8) call abort() end subroutine four subroutine five() integer, save :: foo(2)[5:7,4:*] integer :: i i = 1 foo(1)[5,4] = 42 if (foo(1)[5,4] /= 42) call abort() if (this_image(foo,dim=i) /= 5) call abort() if (lcobound(foo,dim=i) /= 5) call abort() if (ucobound(foo,dim=i) /= 7) call abort() i = 2 if (this_image(foo,dim=i) /= 4) call abort() if (lcobound(foo,dim=i) /= 4) call abort() if (ucobound(foo,dim=i) /= 4) call abort() end subroutine five end program test