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