1! { dg-do run } 2! 3! This program does a correctness check for 4! ARRAY[idx] = ARRAY[idx] and SCALAR[idx] = SCALAR[idx] 5! 6 7 8! 9! FIXME: two/three has to be modified, test has to be checked and 10! diagnostic has to be removed 11! 12 13program main 14 implicit none 15 integer, parameter :: n = 3 16 integer, parameter :: m = 4 17 18 ! Allocatable coarrays 19 call one(-5, 1) 20 call one(0, 0) 21 call one(1, -5) 22 call one(0, -11) 23 24 ! Static coarrays 25 call two() 26 call three() 27contains 28 subroutine one(lb1, lb2) 29 integer, value :: lb1, lb2 30 31 integer :: i_sgn1, i_sgn2, i, i_e, i_s, j, j_e, j_s 32 integer, allocatable :: caf(:,:)[:], caf2(:,:)[:] 33 integer, allocatable :: a(:,:), b(:,:) 34 35 allocate(caf(lb1:n+lb1-1, lb2:m+lb2-1)[*], & 36 caf2(lb1:n+lb1-1, lb2:m+lb2-1)[*], & 37 a(lb1:n+lb1-1, lb2:m+lb2-1), & 38 b(lb1:n+lb1-1, lb2:m+lb2-1)) 39 40 b = reshape([(i*33, i = 1, size(b))], shape(b)) 41 42 ! Whole array: ARRAY = ARRAY 43 caf = -42 44 a = -42 45 caf2 = -42 46 if (this_image() == num_images()) then 47 caf(:,:) = b(:,:) 48 endif 49 sync all 50 a(:,:) = b(:,:) 51 caf2(:,:)[this_image()] = caf(:,:)[num_images()] 52 if (any (a /= caf2)) then 53 STOP 1 54 end if 55 sync all 56 57 ! Scalar assignment 58 caf = -42 59 a = -42 60 caf2 = -42 61 if (this_image() == num_images()) then 62 caf(:,:) = b(:,:) 63 endif 64 sync all 65 do j = lb2, m+lb2-1 66 do i = n+lb1-1, lb1, -2 67 a(i,j) = b(i,j) 68 caf2(i,j)[this_image()] = caf(i,j)[num_images()] 69 end do 70 end do 71 do j = lb2, m+lb2-1 72 do i = lb1, n+lb1-1, 2 73 a(i,j) = b(i,j) 74 caf2(i,j)[this_image()] = caf(i,j)[num_images()] 75 end do 76 end do 77 if (any (a /= caf2)) then 78 STOP 2 79 end if 80 sync all 81 82 ! Array sections with different ranges and pos/neg strides 83 do i_sgn1 = -1, 1, 2 84 do i_sgn2 = -1, 1, 2 85 do i=lb1, n+lb1-1 86 do i_e=lb1, n+lb1-1 87 do i_s=1, n 88 do j=lb2, m+lb2-1 89 do j_e=lb2, m+lb2-1 90 do j_s=1, m 91 ! ARRAY = ARRAY 92 caf = -42 93 a = -42 94 caf2 = -42 95 if (this_image() == num_images()) then 96 caf(:,:) = b(:,:) 97 endif 98 sync all 99 a(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) & 100 = b(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) 101 caf2(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[this_image()] & 102 = caf(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[num_images()] 103 if (any (caf2 /= a)) then 104 STOP 3 105 end if 106 sync all 107 end do 108 end do 109 end do 110 end do 111 end do 112 end do 113 end do 114 end do 115 end subroutine one 116 117 subroutine two() 118 integer, parameter :: lb1 = -5, lb2 = 1 119 120 integer :: i_sgn1, i_sgn2, i, i_e, i_s, j, j_e, j_s 121 integer, save :: caf(lb1:n+lb1-1, lb2:m+lb2-1)[*] 122 integer, save :: caf2(lb1:n+lb1-1, lb2:m+lb2-1)[*] 123 integer, save :: a(lb1:n+lb1-1, lb2:m+lb2-1) 124 integer, save :: b(lb1:n+lb1-1, lb2:m+lb2-1) 125 126 b = reshape([(i*33, i = 1, size(b))], shape(b)) 127 128 ! Whole array: ARRAY = ARRAY 129 caf = -42 130 a = -42 131 caf2 = -42 132 if (this_image() == num_images()) then 133 caf(:,:) = b(:,:) 134 endif 135 sync all 136 a(:,:) = b(:,:) 137 caf2(:,:)[this_image()] = caf(:,:)[num_images()] 138 if (any (a /= caf2)) then 139 STOP 4 140 end if 141 sync all 142 143 ! Scalar assignment 144 caf = -42 145 a = -42 146 caf2 = -42 147 if (this_image() == num_images()) then 148 caf(:,:) = b(:,:) 149 endif 150 sync all 151 do j = lb2, m+lb2-1 152 do i = n+lb1-1, lb1, -2 153 a(i,j) = b(i,j) 154 caf2(i,j)[this_image()] = caf(i,j)[num_images()] 155 end do 156 end do 157 do j = lb2, m+lb2-1 158 do i = lb1, n+lb1-1, 2 159 a(i,j) = b(i,j) 160 caf2(i,j)[this_image()] = caf(i,j)[num_images()] 161 end do 162 end do 163 if (any (a /= caf2)) then 164 STOP 5 165 end if 166 sync all 167 168 ! Array sections with different ranges and pos/neg strides 169 do i_sgn1 = -1, 1, 2 170 do i_sgn2 = -1, 1, 2 171 do i=lb1, n+lb1-1 172 do i_e=lb1, n+lb1-1 173 do i_s=1, n 174 do j=lb2, m+lb2-1 175 do j_e=lb2, m+lb2-1 176 do j_s=1, m 177 ! ARRAY = ARRAY 178 caf = -42 179 a = -42 180 caf2 = -42 181 if (this_image() == num_images()) then 182 caf(:,:) = b(:,:) 183 endif 184 sync all 185 a(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) & 186 = b(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) 187 caf2(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[this_image()] & 188 = caf(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[num_images()] 189 if (any (caf2 /= a)) then 190 STOP 6 191 end if 192 sync all 193 end do 194 end do 195 end do 196 end do 197 end do 198 end do 199 end do 200 end do 201 end subroutine two 202 203 subroutine three() 204 integer, parameter :: lb1 = 0, lb2 = 0 205 206 integer :: i_sgn1, i_sgn2, i, i_e, i_s, j, j_e, j_s 207 integer, save :: caf(lb1:n+lb1-1, lb2:m+lb2-1)[*] 208 integer, save :: caf2(lb1:n+lb1-1, lb2:m+lb2-1)[*] 209 integer, save :: a(lb1:n+lb1-1, lb2:m+lb2-1) 210 integer, save :: b(lb1:n+lb1-1, lb2:m+lb2-1) 211 212 b = reshape([(i*33, i = 1, size(b))], shape(b)) 213 214 ! Whole array: ARRAY = ARRAY 215 caf = -42 216 a = -42 217 caf2 = -42 218 if (this_image() == num_images()) then 219 caf(:,:) = b(:,:) 220 endif 221 sync all 222 a(:,:) = b(:,:) 223 caf2(:,:)[this_image()] = caf(:,:)[num_images()] 224 if (any (a /= caf2)) then 225 STOP 7 226 end if 227 sync all 228 229 ! Scalar assignment 230 caf = -42 231 a = -42 232 caf2 = -42 233 if (this_image() == num_images()) then 234 caf(:,:) = b(:,:) 235 endif 236 sync all 237 do j = lb2, m+lb2-1 238 do i = n+lb1-1, lb1, -2 239 a(i,j) = b(i,j) 240 caf2(i,j)[this_image()] = caf(i,j)[num_images()] 241 end do 242 end do 243 do j = lb2, m+lb2-1 244 do i = lb1, n+lb1-1, 2 245 a(i,j) = b(i,j) 246 caf2(i,j)[this_image()] = caf(i,j)[num_images()] 247 end do 248 end do 249 if (any (a /= caf2)) then 250 STOP 8 251 end if 252 sync all 253 254 ! Array sections with different ranges and pos/neg strides 255 do i_sgn1 = -1, 1, 2 256 do i_sgn2 = -1, 1, 2 257 do i=lb1, n+lb1-1 258 do i_e=lb1, n+lb1-1 259 do i_s=1, n 260 do j=lb2, m+lb2-1 261 do j_e=lb2, m+lb2-1 262 do j_s=1, m 263 ! ARRAY = ARRAY 264 caf = -42 265 a = -42 266 caf2 = -42 267 if (this_image() == num_images()) then 268 caf(:,:) = b(:,:) 269 endif 270 sync all 271 a(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) & 272 = b(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) 273 caf2(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[this_image()] & 274 = caf(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[num_images()] 275 if (any (caf2 /= a)) then 276 STOP 9 277 end if 278 sync all 279 end do 280 end do 281 end do 282 end do 283 end do 284 end do 285 end do 286 end do 287 end subroutine three 288end program main 289