gcc/testsuite/gfortran.dg/coarray/get_array.f90

   1 ! { dg-do run }
   2 !
   3 ! This program does a correctness check for
   4 ! ... = ARRAY[idx] and ... = 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
  13 program 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()
  27 contains
  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(:,:)[:]
  33     integer, allocatable :: a(:,:), b(:,:), c(:,:)
  34
  35     allocate(caf(lb1:n+lb1-1, lb2:m+lb2-1)[*], &
  36          a(lb1:n+lb1-1, lb2:m+lb2-1), &
  37          b(lb1:n+lb1-1, lb2:m+lb2-1), &
  38          c(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     c = -42
  46     if (this_image() == num_images()) then
  47       caf(:,:) = b(:,:)
  48     endif
  49     sync all
  50     a(:,:) = b(:,:)
  51     c(:,:) = caf(:,:)[num_images()]
  52     if (any (a /= c)) then
  53       call abort()
  54     end if
  55     sync all
  56
  57     ! Scalar assignment
  58     caf = -42
  59     a = -42
  60     c = -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         c(i,j) = 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         c(i,j) = caf(i,j)[num_images()]
  75       end do
  76     end do
  77     if (any (a /= c)) then
  78       call abort()
  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                     c = -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                     c(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) &
 102                          = caf(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[num_images()]
 103                     if (any (c /= a)) then
 104                       call abort()
 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 :: a(lb1:n+lb1-1, lb2:m+lb2-1)
 123     integer, save :: b(lb1:n+lb1-1, lb2:m+lb2-1)
 124     integer, save :: c(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     c = -42
 132     if (this_image() == num_images()) then
 133       caf(:,:) = b(:,:)
 134     endif
 135     sync all
 136     a(:,:) = b(:,:)
 137     c(:,:) = caf(:,:)[num_images()]
 138     if (any (a /= c)) then
 139       call abort()
 140     end if
 141     sync all
 142
 143     ! Scalar assignment
 144     caf = -42
 145     a = -42
 146     c = -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         c(i,j) = 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         c(i,j) = caf(i,j)[num_images()]
 161       end do
 162     end do
 163     if (any (a /= c)) then
 164       call abort()
 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                     c = -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                     c(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) &
 188                          = caf(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[num_images()]
 189                     if (any (c /= a)) then
 190                       call abort()
 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 :: a(lb1:n+lb1-1, lb2:m+lb2-1)
 209     integer, save :: b(lb1:n+lb1-1, lb2:m+lb2-1)
 210     integer, save :: c(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     c = -42
 218     if (this_image() == num_images()) then
 219       caf(:,:) = b(:,:)
 220     endif
 221     sync all
 222     a(:,:) = b(:,:)
 223     c(:,:) = caf(:,:)[num_images()]
 224     if (any (a /= c)) then
 225       call abort()
 226     end if
 227     sync all
 228
 229     ! Scalar assignment
 230     caf = -42
 231     a = -42
 232     c = -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         c(i,j) = 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         c(i,j) = caf(i,j)[num_images()]
 247       end do
 248     end do
 249     if (any (a /= c)) then
 250       call abort()
 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                     c = -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                     c(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) &
 274                          = caf(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[num_images()]
 275                     if (any (c /= a)) then
 276                       call abort()
 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
 288 end program main