From: Thomas Koenig Date: Thu, 17 Dec 2020 21:32:02 +0000 (+0100) Subject: Add a few test cases that work for shared coarrays. X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=96c23f6580238cb8366fa0ae964ce6f3bf7da653;p=thirdparty%2Fgcc.git Add a few test cases that work for shared coarrays. gcc/testsuite/ChangeLog: * gfortran.dg/caf-shared/coarray_13.f90: New test. * gfortran.dg/caf-shared/get_array.f90: New test. * gfortran.dg/caf-shared/sendget_array.f90: New test. --- diff --git a/gcc/testsuite/gfortran.dg/caf-shared/coarray_13.f90 b/gcc/testsuite/gfortran.dg/caf-shared/coarray_13.f90 new file mode 100644 index 000000000000..528fd5c03828 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/caf-shared/coarray_13.f90 @@ -0,0 +1,150 @@ +! { dg-do run } +! { dg-options "-fcoarray=single -fcheck=bounds" } +! { dg-set-target-env-var GFORTRAN_NUM_IMAGES "4" } +! +! 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) STOP 1 + if (lcobound (a,dim=1) /= -4_8) STOP 2 + if (ucobound (a,dim=1) /= 9_8) STOP 3 + + if (this_image(a,dim=2) /= 1_8) STOP 4 + if (lcobound (a,dim=2) /= 1_8) STOP 5 + if (ucobound (a,dim=2) /= 8_8) STOP 6 + + if (this_image(a,dim=3) /= 4_8) STOP 7 + if (lcobound (a,dim=3) /= 4_8) STOP 8 + if (ucobound (a,dim=3) /= 4_8) STOP 9 + + if (any(this_image(a) /= [-4_8, 1_8, 4_8])) STOP 10 + if (any(lcobound (a) /= [-4_8, 1_8, 4_8])) STOP 11 + if (any(ucobound (a) /= [9_8, 8_8, 4_8])) STOP 12 + end subroutine one + + subroutine two() + integer, allocatable :: a(:)[:,:,:] + allocate(a(1)[-4:9,8,4:*]) + + if (this_image(a,dim=1) /= -4) STOP 13 + if (lcobound (a,dim=1) /= -4) STOP 14 + if (ucobound (a,dim=1) /= 9) STOP 15 + + if (this_image(a,dim=2) /= 1) STOP 16 + if (lcobound (a,dim=2) /= 1) STOP 17 + if (ucobound (a,dim=2) /= 8) STOP 18 + + if (this_image(a,dim=3) /= 4) STOP 19 + if (lcobound (a,dim=3) /= 4) STOP 20 + if (ucobound (a,dim=3) /= 4) STOP 21 + + if (any(this_image(a) /= [-4, 1, 4])) STOP 22 + if (any(lcobound (a) /= [-4, 1, 4])) STOP 23 + if (any(ucobound (a) /= [9, 8, 4])) STOP 24 + end subroutine two + + subroutine three(n,A, n2) + integer :: n, n2 + integer :: A(3)[n:*] + + A(1) = 42 + if (A(1) /= 42) STOP 25 + A(1)[n2] = -42 + if (A(1)[n2] /= -42) STOP 26 + + if (this_image(A,dim=1) /= n) STOP 27 + if (lcobound (A,dim=1) /= n) STOP 28 + if (ucobound (A,dim=1) /= n) STOP 29 + + if (any(this_image(A) /= n)) STOP 30 + if (any(lcobound (A) /= n)) STOP 31 + if (any(ucobound (A) /= n)) STOP 32 + 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) STOP 33 + A(1)[4,n] = -42 + if (A(1)[4,n] /= -42) STOP 34 + + if (this_image(A,dim=1) /= n+2) STOP 35 + if (lcobound (A,dim=1) /= n+2) STOP 36 + if (ucobound (A,dim=1) /= n+5) STOP 37 + + if (this_image(A,dim=2) /= n-1) STOP 38 + if (lcobound (A,dim=2) /= n-1) STOP 39 + if (ucobound (A,dim=2) /= n-1) STOP 40 + + if (any(this_image(A) /= [n+2,n-1])) STOP 41 + if (any(lcobound (A) /= [n+2,n-1])) STOP 42 + if (any(ucobound (A) /= [n+5,n-1])) STOP 43 + 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) STOP 44 + A(1,0,-2,-4) = 99 + if (A(1,0,-2,-4) /= 99) STOP 45 + + if (this_image(A,dim=1) /= n+2) STOP 46 + if (lcobound (A,dim=1) /= n+2) STOP 47 + if (ucobound (A,dim=1) /= n+5) STOP 48 + + if (this_image(A,dim=2) /= n-1) STOP 49 + if (lcobound (A,dim=2) /= n-1) STOP 50 + if (ucobound (A,dim=2) /= n-1) STOP 51 + + if (any(this_image(A) /= [n+2,n-1])) STOP 52 + if (any(lcobound (A) /= [n+2,n-1])) STOP 53 + if (any(ucobound (A) /= [n+5,n-1])) STOP 54 + end subroutine three_b + + subroutine four(A) + integer, allocatable :: A(:)[:] + if (this_image(A,dim=1) /= -4_8) STOP 55 + if (lcobound (A,dim=1) /= -4_8) STOP 56 + if (ucobound (A,dim=1) /= -4_8) STOP 57 + 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) STOP 58 + if (this_image(foo,dim=i) /= 5) STOP 59 + if (lcobound(foo,dim=i) /= 5) STOP 60 + if (ucobound(foo,dim=i) /= 7) STOP 61 + + i = 2 + if (this_image(foo,dim=i) /= 4) STOP 62 + if (lcobound(foo,dim=i) /= 4) STOP 63 + if (ucobound(foo,dim=i) /= 4) STOP 64 + end subroutine five +end program test diff --git a/gcc/testsuite/gfortran.dg/caf-shared/get_array.f90 b/gcc/testsuite/gfortran.dg/caf-shared/get_array.f90 new file mode 100644 index 000000000000..aa9598e1486d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/caf-shared/get_array.f90 @@ -0,0 +1,288 @@ +! { dg-do run } +! { dg-set-target-env-var GFORTRAN_NUM_IMAGES "4" } +! This program does a correctness check for +! ... = ARRAY[idx] and ... = SCALAR[idx] +! + + +! +! FIXME: two/three has to be modified, test has to be checked and +! diagnostic has to be removed +! + +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(:,:), c(:,:) + + 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), & + c(lb1:n+lb1-1, lb2:m+lb2-1)) + + b = reshape([(i*33, i = 1, size(b))], shape(b)) + + ! Whole array: ARRAY = ARRAY + caf = -42 + a = -42 + c = -42 + if (this_image() == num_images()) then + caf(:,:) = b(:,:) + endif + sync all + a(:,:) = b(:,:) + c(:,:) = caf(:,:)[num_images()] + if (any (a /= c)) then + STOP 1 + end if + sync all + + ! Scalar assignment + caf = -42 + a = -42 + c = -42 + if (this_image() == num_images()) then + caf(:,:) = b(:,:) + endif + sync all + do j = lb2, m+lb2-1 + do i = n+lb1-1, lb1, -2 + a(i,j) = b(i,j) + c(i,j) = caf(i,j)[num_images()] + end do + end do + do j = lb2, m+lb2-1 + do i = lb1, n+lb1-1, 2 + a(i,j) = b(i,j) + c(i,j) = caf(i,j)[num_images()] + end do + end do + if (any (a /= c)) then + STOP 2 + 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 = ARRAY + caf = -42 + a = -42 + c = -42 + if (this_image() == num_images()) then + caf(:,:) = b(:,:) + endif + sync all + 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) + c(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) & + = caf(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[num_images()] + if (any (c /= a)) then + STOP 3 + 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) + integer, save :: c(lb1:n+lb1-1, lb2:m+lb2-1) + + b = reshape([(i*33, i = 1, size(b))], shape(b)) + + ! Whole array: ARRAY = ARRAY + caf = -42 + a = -42 + c = -42 + if (this_image() == num_images()) then + caf(:,:) = b(:,:) + endif + sync all + a(:,:) = b(:,:) + c(:,:) = caf(:,:)[num_images()] + if (any (a /= c)) then + STOP 4 + end if + sync all + + ! Scalar assignment + caf = -42 + a = -42 + c = -42 + if (this_image() == num_images()) then + caf(:,:) = b(:,:) + endif + sync all + do j = lb2, m+lb2-1 + do i = n+lb1-1, lb1, -2 + a(i,j) = b(i,j) + c(i,j) = caf(i,j)[num_images()] + end do + end do + do j = lb2, m+lb2-1 + do i = lb1, n+lb1-1, 2 + a(i,j) = b(i,j) + c(i,j) = caf(i,j)[num_images()] + end do + end do + if (any (a /= c)) then + STOP 5 + 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 = ARRAY + caf = -42 + a = -42 + c = -42 + if (this_image() == num_images()) then + caf(:,:) = b(:,:) + endif + sync all + 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) + c(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) & + = caf(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[num_images()] + if (any (c /= a)) then + STOP 6 + 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) + integer, save :: c(lb1:n+lb1-1, lb2:m+lb2-1) + + b = reshape([(i*33, i = 1, size(b))], shape(b)) + + ! Whole array: ARRAY = ARRAY + caf = -42 + a = -42 + c = -42 + if (this_image() == num_images()) then + caf(:,:) = b(:,:) + endif + sync all + a(:,:) = b(:,:) + c(:,:) = caf(:,:)[num_images()] + if (any (a /= c)) then + STOP 7 + end if + sync all + + ! Scalar assignment + caf = -42 + a = -42 + c = -42 + if (this_image() == num_images()) then + caf(:,:) = b(:,:) + endif + sync all + do j = lb2, m+lb2-1 + do i = n+lb1-1, lb1, -2 + a(i,j) = b(i,j) + c(i,j) = caf(i,j)[num_images()] + end do + end do + do j = lb2, m+lb2-1 + do i = lb1, n+lb1-1, 2 + a(i,j) = b(i,j) + c(i,j) = caf(i,j)[num_images()] + end do + end do + if (any (a /= c)) then + STOP 8 + 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 = ARRAY + caf = -42 + a = -42 + c = -42 + if (this_image() == num_images()) then + caf(:,:) = b(:,:) + endif + sync all + 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) + c(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2) & + = caf(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[num_images()] + if (any (c /= a)) then + STOP 9 + 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 diff --git a/gcc/testsuite/gfortran.dg/caf-shared/sendget_array.f90 b/gcc/testsuite/gfortran.dg/caf-shared/sendget_array.f90 new file mode 100644 index 000000000000..e5514704fa6b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/caf-shared/sendget_array.f90 @@ -0,0 +1,288 @@ +! { dg-do run } +! { dg-set-target-env-var GFORTRAN_NUM_IMAGES "4" } +! This program does a correctness check for +! ARRAY[idx] = ARRAY[idx] and SCALAR[idx] = SCALAR[idx] +! + + +! +! FIXME: two/three has to be modified, test has to be checked and +! diagnostic has to be removed +! + +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(:,:)[:], caf2(:,:)[:] + integer, allocatable :: a(:,:), b(:,:) + + allocate(caf(lb1:n+lb1-1, lb2:m+lb2-1)[*], & + caf2(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 = ARRAY + caf = -42 + a = -42 + caf2 = -42 + if (this_image() == num_images()) then + caf(:,:) = b(:,:) + endif + sync all + a(:,:) = b(:,:) + caf2(:,:)[this_image()] = caf(:,:)[num_images()] + if (any (a /= caf2)) then + STOP 1 + end if + sync all + + ! Scalar assignment + caf = -42 + a = -42 + caf2 = -42 + if (this_image() == num_images()) then + caf(:,:) = b(:,:) + endif + sync all + do j = lb2, m+lb2-1 + do i = n+lb1-1, lb1, -2 + a(i,j) = b(i,j) + caf2(i,j)[this_image()] = caf(i,j)[num_images()] + end do + end do + do j = lb2, m+lb2-1 + do i = lb1, n+lb1-1, 2 + a(i,j) = b(i,j) + caf2(i,j)[this_image()] = caf(i,j)[num_images()] + end do + end do + if (any (a /= caf2)) then + STOP 2 + 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 = ARRAY + caf = -42 + a = -42 + caf2 = -42 + if (this_image() == num_images()) then + caf(:,:) = b(:,:) + endif + sync all + 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) + caf2(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[this_image()] & + = caf(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[num_images()] + if (any (caf2 /= a)) then + STOP 3 + 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 :: caf2(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 = ARRAY + caf = -42 + a = -42 + caf2 = -42 + if (this_image() == num_images()) then + caf(:,:) = b(:,:) + endif + sync all + a(:,:) = b(:,:) + caf2(:,:)[this_image()] = caf(:,:)[num_images()] + if (any (a /= caf2)) then + STOP 4 + end if + sync all + + ! Scalar assignment + caf = -42 + a = -42 + caf2 = -42 + if (this_image() == num_images()) then + caf(:,:) = b(:,:) + endif + sync all + do j = lb2, m+lb2-1 + do i = n+lb1-1, lb1, -2 + a(i,j) = b(i,j) + caf2(i,j)[this_image()] = caf(i,j)[num_images()] + end do + end do + do j = lb2, m+lb2-1 + do i = lb1, n+lb1-1, 2 + a(i,j) = b(i,j) + caf2(i,j)[this_image()] = caf(i,j)[num_images()] + end do + end do + if (any (a /= caf2)) then + STOP 5 + 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 = ARRAY + caf = -42 + a = -42 + caf2 = -42 + if (this_image() == num_images()) then + caf(:,:) = b(:,:) + endif + sync all + 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) + caf2(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[this_image()] & + = caf(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[num_images()] + if (any (caf2 /= a)) then + STOP 6 + 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 :: caf2(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 = ARRAY + caf = -42 + a = -42 + caf2 = -42 + if (this_image() == num_images()) then + caf(:,:) = b(:,:) + endif + sync all + a(:,:) = b(:,:) + caf2(:,:)[this_image()] = caf(:,:)[num_images()] + if (any (a /= caf2)) then + STOP 7 + end if + sync all + + ! Scalar assignment + caf = -42 + a = -42 + caf2 = -42 + if (this_image() == num_images()) then + caf(:,:) = b(:,:) + endif + sync all + do j = lb2, m+lb2-1 + do i = n+lb1-1, lb1, -2 + a(i,j) = b(i,j) + caf2(i,j)[this_image()] = caf(i,j)[num_images()] + end do + end do + do j = lb2, m+lb2-1 + do i = lb1, n+lb1-1, 2 + a(i,j) = b(i,j) + caf2(i,j)[this_image()] = caf(i,j)[num_images()] + end do + end do + if (any (a /= caf2)) then + STOP 8 + 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 = ARRAY + caf = -42 + a = -42 + caf2 = -42 + if (this_image() == num_images()) then + caf(:,:) = b(:,:) + endif + sync all + 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) + caf2(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[this_image()] & + = caf(i:i_e:i_s*i_sgn1, j:j_e:j_s*i_sgn2)[num_images()] + if (any (caf2 /= a)) then + STOP 9 + 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