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

! { dg-do run }
!
! This program does a correctness check for
! ARRAY[idx] = SCALAR, ARRAY[idx] = ARRAY and SCALAR[idx] = SCALAR
!
program main
  implicit none
  integer, parameter :: n = 3
  integer, parameter :: m = 4

  ! Allocatable coarrays
  call one(-5, 1)
  call one(0, 0)
  call one(1, -5)
  call one(0, -11)

  ! Static coarrays
  call two()
  call three()
contains
  subroutine one(lb1, lb2)
    integer, value :: lb1, lb2

    integer :: i_sgn1, i_sgn2, i, i_e, i_s, j, j_e, j_s
    integer, allocatable :: caf(:,:)[:]
    integer, allocatable :: a(:,:), b(:,:)

    allocate(caf(lb1:n+lb1-1, lb2:m+lb2-1)[*], &
         a(lb1:n+lb1-1, lb2:m+lb2-1), &
         b(lb1:n+lb1-1, lb2:m+lb2-1))

    b = reshape([(i*33, i = 1, size(b))], shape(b))

    ! Whole array: ARRAY = SCALAR
    caf = -42
    a = -42
    a(:,:) = b(lb1, lb2)
    sync all
    if (this_image() == 1) then
      caf(:,:)[num_images()] = b(lb1, lb2)
    end if
    sync all
    if (this_image() == num_images()) then
      if (any (a /= caf)) &
           STOP 1
    end if
    sync all

    ! Whole array: ARRAY = ARRAY
    caf = -42
    a = -42
    a(:,:) = b(:, :)
    sync all
    if (this_image() == 1) then
      caf(:,:)[num_images()] = b(:, :)
    end if
    sync all
    if (this_image() == num_images()) then
      if (any (a /= caf)) &
           STOP 2
    end if
    sync all

    ! Scalar assignment
    caf = -42
    a = -42
    do j = lb2, m+lb2-1
      do i = n+lb1-1, 1, -2
        a(i,j) = b(i,j)
      end do
    end do
    do j = lb2, m+lb2-1
      do i = 1, n+lb1-1, 2
        a(i,j) = b(i,j)
      end do
    end do
    sync all
    if (this_image() == 1) then
      do j = lb2, m+lb2-1
        do i = n+lb1-1, 1, -2
          caf(i,j)[num_images()] = b(i, j)
        end do
      end do
      do j = lb2, m+lb2-1
        do i = 1, n+lb1-1, 2
          caf(i,j)[num_images()] = b(i, j)
        end do
      end do
    end if
    sync all
    if (this_image() == num_images()) then
      if (any (a /= caf)) &
           STOP 3
    end if
    sync all

    ! Array sections with different ranges and pos/neg strides
    do i_sgn1 = -1, 1, 2
      do i_sgn2 = -1, 1, 2
        do i=lb1, n+lb1-1
          do i_e=lb1, n+lb1-1
            do i_s=1, n
              do j=lb2, m+lb2-1
                do j_e=lb2, m+lb2-1
                  do j_s=1, m
                    ! ARRAY = SCALAR
                    caf = -42
                    a = -42
                    a(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) = b(lb1, lb2)
                    sync all
                    if (this_image() == 1) then
                      caf(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[num_images()] &
                           = b(lb1, lb2)
                    end if
                    sync all

                    ! ARRAY = ARRAY
                    caf = -42
                    a = -42
                    a(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) &
                         = b(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)
                    sync all
                    if (this_image() == 1) then
                      caf(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[num_images()] &
                           = b(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)
                    end if
                    sync all

                    if (this_image() == num_images()) then
                      if (any (a /= caf)) then
                        print '(*(g0))', "bounds: ", lb1,":",n+lb1-1,", ", &
                             lb2,":",m+lb2-1
                        print '(*(g0))', "section: ", i,":",i_e,":",i_s*i_sgn1, &
                             ", ", j,":",j_e,":",j_s*i_sgn2
                        print *, i
                        print *, a
                        print *, caf
                        print *, a-caf
                        STOP 4
                      endif
                    end if
                    sync all
                  end do
                end do
              end do
            end do
          end do
        end do
      end do
    end do
  end subroutine one

  subroutine two()
    integer, parameter :: lb1 = -5, lb2 = 1

    integer :: i_sgn1, i_sgn2, i, i_e, i_s, j, j_e, j_s
    integer, save :: caf(lb1:n+lb1-1, lb2:m+lb2-1)[*]
    integer, save :: a(lb1:n+lb1-1, lb2:m+lb2-1)
    integer, save :: b(lb1:n+lb1-1, lb2:m+lb2-1)

    b = reshape([(i*33, i = 1, size(b))], shape(b))

    ! Whole array: ARRAY = SCALAR
    caf = -42
    a = -42
    a(:,:) = b(lb1, lb2)
    sync all
    if (this_image() == 1) then
      caf(:,:)[num_images()] = b(lb1, lb2)
    end if
    sync all
    if (this_image() == num_images()) then
      if (any (a /= caf)) &
           STOP 5
    end if

    ! Whole array: ARRAY = ARRAY
    caf = -42
    a = -42
    a(:,:) = b(:, :)
    sync all
    if (this_image() == 1) then
      caf(:,:)[num_images()] = b(:, :)
    end if
    sync all
    if (this_image() == num_images()) then
      if (any (a /= caf)) &
           STOP 6
    end if
    sync all

    ! Scalar assignment
    caf = -42
    a = -42
    do j = lb2, m+lb2-1
      do i = n+lb1-1, 1, -2
        a(i,j) = b(i,j)
      end do
    end do
    do j = lb2, m+lb2-1
      do i = 1, n+lb1-1, 2
        a(i,j) = b(i,j)
      end do
    end do
    sync all
    if (this_image() == 1) then
      do j = lb2, m+lb2-1
        do i = n+lb1-1, 1, -2
          caf(i,j)[num_images()] = b(i, j)
        end do
      end do
      do j = lb2, m+lb2-1
        do i = 1, n+lb1-1, 2
          caf(i,j)[num_images()] = b(i, j)
        end do
      end do
    end if
    sync all
    if (this_image() == num_images()) then
      if (any (a /= caf)) &
           STOP 7
    end if
    sync all

    ! Array sections with different ranges and pos/neg strides
    do i_sgn1 = -1, 1, 2
      do i_sgn2 = -1, 1, 2
        do i=lb1, n+lb1-1
          do i_e=lb1, n+lb1-1
            do i_s=1, n
              do j=lb2, m+lb2-1
                do j_e=lb2, m+lb2-1
                  do j_s=1, m
                    ! ARRAY = SCALAR
                    caf = -42
                    a = -42
                    a(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) = b(lb1, lb2)
                    sync all
                    if (this_image() == 1) then
                      caf(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[num_images()] &
                           = b(lb1, lb2)
                    end if
                    sync all

                    ! ARRAY = ARRAY
                    caf = -42
                    a = -42
                    a(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) &
                         = b(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)
                    sync all
                    if (this_image() == 1) then
                      caf(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[num_images()] &
                           = b(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)
                    end if
                    sync all

                    if (this_image() == num_images()) then
                      if (any (a /= caf)) then
                        print '(*(g0))', "bounds: ", lb1,":",n+lb1-1,", ", &
                             lb2,":",m+lb2-1
                        print '(*(g0))', "section: ", i,":",i_e,":",i_s*i_sgn1, &
                             ", ", j,":",j_e,":",j_s*i_sgn2
                        print *, i
                        print *, a
                        print *, caf
                        print *, a-caf
                        STOP 8
                      endif
                    end if
                    sync all
                  end do
                end do
              end do
            end do
          end do
        end do
      end do
    end do
  end subroutine two

  subroutine three()
    integer, parameter :: lb1 = 0, lb2 = 0

    integer :: i_sgn1, i_sgn2, i, i_e, i_s, j, j_e, j_s
    integer, save :: caf(lb1:n+lb1-1, lb2:m+lb2-1)[*]
    integer, save :: a(lb1:n+lb1-1, lb2:m+lb2-1)
    integer, save :: b(lb1:n+lb1-1, lb2:m+lb2-1)

    b = reshape([(i*33, i = 1, size(b))], shape(b))

    ! Whole array: ARRAY = SCALAR
    caf = -42
    a = -42
    a(:,:) = b(lb1, lb2)
    sync all
    if (this_image() == 1) then
      caf(:,:)[num_images()] = b(lb1, lb2)
    end if
    sync all
    if (this_image() == num_images()) then
      if (any (a /= caf)) &
           STOP 9
    end if

    ! Whole array: ARRAY = ARRAY
    caf = -42
    a = -42
    a(:,:) = b(:, :)
    sync all
    if (this_image() == 1) then
      caf(:,:)[num_images()] = b(:, :)
    end if
    sync all
    if (this_image() == num_images()) then
      if (any (a /= caf)) &
           STOP 10
    end if
    sync all

    ! Scalar assignment
    caf = -42
    a = -42
    do j = lb2, m+lb2-1
      do i = n+lb1-1, 1, -2
        a(i,j) = b(i,j)
      end do
    end do
    do j = lb2, m+lb2-1
      do i = 1, n+lb1-1, 2
        a(i,j) = b(i,j)
      end do
    end do
    sync all
    if (this_image() == 1) then
      do j = lb2, m+lb2-1
        do i = n+lb1-1, 1, -2
          caf(i,j)[num_images()] = b(i, j)
        end do
      end do
      do j = lb2, m+lb2-1
        do i = 1, n+lb1-1, 2
          caf(i,j)[num_images()] = b(i, j)
        end do
      end do
    end if
    sync all
    if (this_image() == num_images()) then
      if (any (a /= caf)) &
           STOP 11
    end if

    ! Array sections with different ranges and pos/neg strides
    do i_sgn1 = -1, 1, 2
      do i_sgn2 = -1, 1, 2
        do i=lb1, n+lb1-1
          do i_e=lb1, n+lb1-1
            do i_s=1, n
              do j=lb2, m+lb2-1
                do j_e=lb2, m+lb2-1
                  do j_s=1, m
                    ! ARRAY = SCALAR
                    caf = -42
                    a = -42
                    a(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) = b(lb1, lb2)
                    sync all
                    if (this_image() == 1) then
                      caf(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[num_images()] &
                           = b(lb1, lb2)
                    end if
                    sync all

                    ! ARRAY = ARRAY
                    caf = -42
                    a = -42
                    a(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) &
                         = b(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)
                    sync all
                    if (this_image() == 1) then
                      caf(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[num_images()] &
                           = b(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)
                    end if
                    sync all

                    if (this_image() == num_images()) then
                      if (any (a /= caf)) then
                        print '(*(g0))', "bounds: ", lb1,":",n+lb1-1,", ", &
                             lb2,":",m+lb2-1
                        print '(*(g0))', "section: ", i,":",i_e,":",i_s*i_sgn1, &
                             ", ", j,":",j_e,":",j_s*i_sgn2
                        print *, i
                        print *, a
                        print *, caf
                        print *, a-caf
                        STOP 12
                      endif
                    end if
                    sync all
                  end do
                end do
              end do
            end do
          end do
        end do
      end do
    end do
  end subroutine three
end program main