public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/coarray_native] Add a few test cases that work for shared coarrays.
@ 2020-12-19 19:49 Thomas König
0 siblings, 0 replies; only message in thread
From: Thomas König @ 2020-12-19 19:49 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:96c23f6580238cb8366fa0ae964ce6f3bf7da653
commit 96c23f6580238cb8366fa0ae964ce6f3bf7da653
Author: Thomas Koenig <tkoenig@gcc.gnu.org>
Date: Thu Dec 17 22:32:02 2020 +0100
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:
---
.../gfortran.dg/caf-shared/coarray_13.f90 | 150 +++++++++++
gcc/testsuite/gfortran.dg/caf-shared/get_array.f90 | 288 +++++++++++++++++++++
.../gfortran.dg/caf-shared/sendget_array.f90 | 288 +++++++++++++++++++++
3 files changed, 726 insertions(+)
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 00000000000..528fd5c0382
--- /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 00000000000..aa9598e1486
--- /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 00000000000..e5514704fa6
--- /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
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2020-12-19 19:49 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-12-19 19:49 [gcc/devel/coarray_native] Add a few test cases that work for shared coarrays Thomas König
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).