public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/coarray_native] Add caf-shared subdirectory to gfortran.dg with passing tests.
@ 2020-12-06 12:28 Thomas Kथघnig
0 siblings, 0 replies; only message in thread
From: Thomas Kथघnig @ 2020-12-06 12:28 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:003b3ce345491e1c70e88320457954313050d7d9
commit 003b3ce345491e1c70e88320457954313050d7d9
Author: Thomas Koenig <tkoenig@gcc.gnu.org>
Date: Sun Dec 6 13:27:19 2020 +0100
Add caf-shared subdirectory to gfortran.dg with passing tests.
gcc/testsuite/ChangeLog:
* gfortran.dg/caf-shared/cas.exp: New file.
* gfortran.dg/caf-shared/alloc_comp_1.f90: New test.
* gfortran.dg/caf-shared/arg_passing_1.f90: New test.
* gfortran.dg/caf-shared/assign_array_1.f90: New test.
* gfortran.dg/caf-shared/atomic_1.f90: New test.
* gfortran.dg/caf-shared/coarray_40.f90: New test.
* gfortran.dg/caf-shared/codimension_2.f90: New test.
* gfortran.dg/caf-shared/codimension_2a.f90: New test.
* gfortran.dg/caf-shared/codimension_2b.f90: New test.
* gfortran.dg/caf-shared/collectives_1.f90: New test.
* gfortran.dg/caf-shared/collectives_2.f90: New test.
* gfortran.dg/caf-shared/collectives_4.f90: New test.
* gfortran.dg/caf-shared/cosubscript_1.f90: New test.
* gfortran.dg/caf-shared/data_1.f90: New test.
* gfortran.dg/caf-shared/dummy_1.f90: New test.
* gfortran.dg/caf-shared/image_index_2.f90: New test.
* gfortran.dg/caf-shared/num_images_1.f90: New test.
* gfortran.dg/caf-shared/subobject_1.f90: New test.
* gfortran.dg/caf-shared/this_image_1.f90: New test.
* gfortran.dg/caf-shared/this_image_2.f90: New test.
Diff:
---
.../gfortran.dg/caf-shared/alloc_comp_1.f90 | 16 ++
.../gfortran.dg/caf-shared/arg_passing_1.f90 | 53 ++++++
.../gfortran.dg/caf-shared/assign_array_1.f90 | 18 ++
gcc/testsuite/gfortran.dg/caf-shared/atomic_1.f90 | 28 +++
gcc/testsuite/gfortran.dg/caf-shared/cas.exp | 61 +++++++
.../gfortran.dg/caf-shared/coarray_40.f90 | 26 +++
.../gfortran.dg/caf-shared/codimension_2.f90 | 14 ++
.../gfortran.dg/caf-shared/codimension_2a.f90 | 29 +++
.../gfortran.dg/caf-shared/codimension_2b.f90 | 13 ++
.../gfortran.dg/caf-shared/collectives_1.f90 | 44 +++++
.../gfortran.dg/caf-shared/collectives_2.f90 | 76 ++++++++
.../gfortran.dg/caf-shared/collectives_4.f90 | 24 +++
.../gfortran.dg/caf-shared/cosubscript_1.f90 | 67 +++++++
gcc/testsuite/gfortran.dg/caf-shared/data_1.f90 | 11 ++
gcc/testsuite/gfortran.dg/caf-shared/dummy_1.f90 | 70 ++++++++
.../gfortran.dg/caf-shared/image_index_2.f90 | 77 ++++++++
.../gfortran.dg/caf-shared/num_images_1.f90 | 7 +
.../gfortran.dg/caf-shared/subobject_1.f90 | 43 +++++
.../gfortran.dg/caf-shared/this_image_1.f90 | 197 +++++++++++++++++++++
.../gfortran.dg/caf-shared/this_image_2.f90 | 125 +++++++++++++
20 files changed, 999 insertions(+)
diff --git a/gcc/testsuite/gfortran.dg/caf-shared/alloc_comp_1.f90 b/gcc/testsuite/gfortran.dg/caf-shared/alloc_comp_1.f90
new file mode 100644
index 00000000000..fb7ce44adc8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/caf-shared/alloc_comp_1.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-set-target-env-var GFORTRAN_NUM_IMAGES "2" }
+! Allocatable scalar corrays were mishandled (ICE)
+!
+type t
+ integer, allocatable :: caf[:]
+end type t
+type(t) :: a
+allocate (a%caf[3:*])
+a%caf = 7
+if (a%caf /= 7) STOP 1
+if (any (lcobound (a%caf) /= [ 3 ]) &
+ .or. ucobound (a%caf, dim=1) /= num_images ()+2) &
+ STOP 2
+deallocate (a%caf)
+end
diff --git a/gcc/testsuite/gfortran.dg/caf-shared/arg_passing_1.f90 b/gcc/testsuite/gfortran.dg/caf-shared/arg_passing_1.f90
new file mode 100644
index 00000000000..c1a0efb4ab4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/caf-shared/arg_passing_1.f90
@@ -0,0 +1,53 @@
+! { dg-do run }
+! { dg-set-target-env-var GFORTRAN_NUM_IMAGES "4" }
+! Miscellaneous tests for argument passing.
+program main
+ implicit none
+ integer, dimension(4):: j[*]
+ integer:: i[*]
+ i = this_image()
+ j = [3, 4, 5, 6] + 100*this_image()
+
+ sync all
+
+ call bar(i)
+ call baz(j)
+ call baw(j)
+ call bay(j)
+contains
+ subroutine bar(x)
+ integer, intent(in):: x[*]
+ integer :: yy
+ yy = x
+ if (yy .ne. this_image()) stop 1
+ end subroutine
+
+ subroutine baz(x)
+ integer, intent(in), dimension(:):: x[*]
+ if (x(1) -100*this_image() .ne. 3) stop 2
+ if (x(4) -100*this_image() .ne. 6) stop 3
+ if (any(x(:)[1] - 100 .ne. [3, 4, 5, 6])) stop 4
+ end subroutine
+
+ subroutine baw(x)
+ integer, parameter :: large = 10**7
+ integer, intent(in), dimension(large:):: x[*]
+ integer:: y, y2
+ ! print *, this_image(), "baw: x, lbound x", x, lbound(x)
+ y = x(large)
+ y2 = x(large + 3)
+ if (y -100*this_image() .ne. 3) stop 5
+ if (y2 -100*this_image() .ne. 6) stop 6
+ end subroutine
+
+ subroutine bay(x)
+ integer, intent(in), dimension(:):: x
+ if (x(1) - 100*this_image() .ne. 3) stop 7
+ if (x(4) - 100*this_image() .ne. 6) stop 8
+ end subroutine
+
+ subroutine baa(x)
+ integer, intent(in):: x
+ if (x .ne. this_image()) stop 9
+ end subroutine
+end program
diff --git a/gcc/testsuite/gfortran.dg/caf-shared/assign_array_1.f90 b/gcc/testsuite/gfortran.dg/caf-shared/assign_array_1.f90
new file mode 100644
index 00000000000..a9410afcc74
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/caf-shared/assign_array_1.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-set-target-env-var GFORTRAN_NUM_IMAGES "2" }
+program main
+ implicit none
+ integer, dimension(5):: a[*]
+ a(1) = 1 + 100*this_image()
+ a(2) = 2
+ a(3) = 3
+ a(4) = 4
+ a(5) = 5
+ sync all
+ call foo(a)
+contains
+ subroutine foo(z)
+ integer, dimension(:), intent(in):: z[*]
+ if (any(a /= [1+100*this_image(), 2,3,4,5])) stop 1
+ end subroutine
+end program
diff --git a/gcc/testsuite/gfortran.dg/caf-shared/atomic_1.f90 b/gcc/testsuite/gfortran.dg/caf-shared/atomic_1.f90
new file mode 100644
index 00000000000..bb7c42f9fe8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/caf-shared/atomic_1.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+! { dg-set-target-env-var GFORTRAN_NUM_IMAGES "4" }
+!
+! PR fortran/18918
+!
+! Basic atomic def/ref test
+!
+
+use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind
+implicit none
+integer(atomic_int_kind) :: a(1)[*]
+logical(atomic_logical_kind) :: c[*]
+intrinsic :: atomic_define
+intrinsic :: atomic_ref
+integer(8) :: b
+logical(1) :: d
+
+call atomic_define(a(1), 7_2)
+call atomic_ref(b, a(1))
+if (b /= a(1)) STOP 1
+
+call atomic_define(c, .false.)
+call atomic_ref(d, c[this_image()])
+if (d .neqv. .false.) STOP 2
+call atomic_define(c[this_image()], .true.)
+call atomic_ref(d, c)
+if (d .neqv. .true.) STOP 3
+end
diff --git a/gcc/testsuite/gfortran.dg/caf-shared/cas.exp b/gcc/testsuite/gfortran.dg/caf-shared/cas.exp
new file mode 100644
index 00000000000..86e6b97090b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/caf-shared/cas.exp
@@ -0,0 +1,61 @@
+# Copyright (C) 2020 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GCC; see the file COPYING3. If not see
+# <http://www.gnu.org/licenses/>.
+#
+# Contributed by Thomas König <tkoenig@gcc.gnu.org>
+
+# Test shared coarray support.
+
+load_lib gfortran-dg.exp
+
+set blddir [lookfor_file [get_multilibs] libcaf_shared]
+puts $blddir
+
+dg-init
+
+global gfortran_test_path
+global gfortran_aux_module_flags
+set gfortran_test_path $srcdir/$subdir
+
+# Return true if the rt library is supported on the target.
+proc check_effective_target_librt_available { } {
+ return [check_no_compiler_messages librt_available executable {
+ int main (void) { return 0; }
+ } "-lrt"]
+}
+
+set maybe_rt_lib ""
+if [check_effective_target_librt_available] {
+ set maybe_rt_lib "-lrt"
+}
+
+# Main loop.
+foreach test [lsort [glob -nocomplain $srcdir/$subdir/*.\[fF\]{,90,95,03,08} ]] {
+ # If we're only testing specific files and this isn't one of them, skip it.
+ if ![runtest_file_p $runtests $test] then {
+ continue
+ }
+ set option_list [list { -O2 } ]
+
+ set nshort [file tail [file dirname $test]]/[file tail $test]
+ list-module-names $test
+
+ foreach flags $option_list {
+ verbose "Testing $nshort (libcaf_single), $flags" 1
+ set gfortran_aux_module_flags "-pthread -fcoarray=shared $flags -lcaf_single"
+ dg-test $test "-pthread -fcoarray=shared $flags -lcaf_shared $maybe_rt_lib" ""
+ cleanup-modules ""
+ }
+}
diff --git a/gcc/testsuite/gfortran.dg/caf-shared/coarray_40.f90 b/gcc/testsuite/gfortran.dg/caf-shared/coarray_40.f90
new file mode 100644
index 00000000000..93a74bea011
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/caf-shared/coarray_40.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+! { dg-options "-fcoarray=lib -lcaf_single" }
+! { dg-additional-options "-latomic" { target libatomic_available } }
+!
+! Run-time test for memory consistency
+!
+! Contributed by Deepak Eachempati
+
+program cp_bug
+ implicit none
+ integer :: v1, v2, u[*]
+ integer :: me
+
+ me = this_image()
+
+ u = 0
+ v1 = 10
+
+ v1 = u[me]
+
+ ! v2 should get value in u (0)
+ v2 = v1
+
+ if(v2 /= u) STOP 1
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/caf-shared/codimension_2.f90 b/gcc/testsuite/gfortran.dg/caf-shared/codimension_2.f90
new file mode 100644
index 00000000000..45d3374e606
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/caf-shared/codimension_2.f90
@@ -0,0 +1,14 @@
+! { dg-do link }
+! { dg-additional-sources "codimension_2a.f90 codimension_2b.f90" }
+!
+! To be used with codimension_2a.f90
+! Check that the coarray declared in the module is accessible
+! by doing a link test
+!
+! Contributed by Alessandro Fanfarillo.
+!
+module global_coarrays
+ implicit none
+ integer,parameter :: n=10
+ integer :: b(10)[*]
+end module global_coarrays
diff --git a/gcc/testsuite/gfortran.dg/caf-shared/codimension_2a.f90 b/gcc/testsuite/gfortran.dg/caf-shared/codimension_2a.f90
new file mode 100644
index 00000000000..3dec4aa9f26
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/caf-shared/codimension_2a.f90
@@ -0,0 +1,29 @@
+! { dg-do compile { target { ! *-*-* } } }
+! SKIP THIS FILE
+!
+! Used by codimension_2.f90
+!
+! Check that the coarray declared in the module is accessible
+! by doing a link test
+!
+! Contributed by Alessandro Fanfarillo.
+!
+program testmod
+ use global_coarrays
+ implicit none
+ external ttest
+
+ integer :: me
+
+ me = this_image()
+
+ b = me
+
+ if(me==1) then
+ b(:) = b(:)[2]
+ write(*,*) b
+ elseif (me == 3) then
+ call ttest()
+ end if
+
+end program testmod
diff --git a/gcc/testsuite/gfortran.dg/caf-shared/codimension_2b.f90 b/gcc/testsuite/gfortran.dg/caf-shared/codimension_2b.f90
new file mode 100644
index 00000000000..c30d051a701
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/caf-shared/codimension_2b.f90
@@ -0,0 +1,13 @@
+! { dg-do compile { target { ! *-*-* } } }
+! SKIP THIS FILE
+!
+! Used by codimension_2.f90
+!
+! Additional file to check that using the module doesn't generate
+! a token symbol. (The module is also used by codimension_2.f90.)
+!
+subroutine ttest
+ use global_coarrays
+ implicit none
+ b(:) = b(:)[2]
+end
diff --git a/gcc/testsuite/gfortran.dg/caf-shared/collectives_1.f90 b/gcc/testsuite/gfortran.dg/caf-shared/collectives_1.f90
new file mode 100644
index 00000000000..3d8c3029834
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/caf-shared/collectives_1.f90
@@ -0,0 +1,44 @@
+! { dg-do run }
+! { dg-set-target-env-var GFORTRAN_NUM_IMAGES "4" }
+! CO_SUM/CO_MIN/CO_MAX
+!
+program test
+ implicit none
+ intrinsic co_max
+ intrinsic co_min
+ intrinsic co_sum
+ call test_min
+ call test_max
+ call test_sum
+contains
+ subroutine test_max
+ integer :: val
+ val = this_image ()
+ call co_max (val, result_image=1)
+ if (this_image() == 1) then
+ !write(*,*) "Maximal value", val
+ if (val /= num_images()) STOP 1
+ end if
+ end subroutine test_max
+
+ subroutine test_min
+ integer :: val
+ val = this_image ()
+ call co_min (val, result_image=1)
+ if (this_image() == 1) then
+ !write(*,*) "Minimal value", val
+ if (val /= 1) STOP 2
+ end if
+ end subroutine test_min
+
+ subroutine test_sum
+ integer :: val, n
+ val = this_image ()
+ call co_sum (val, result_image=1)
+ if (this_image() == 1) then
+ !write(*,*) "The sum is ", val
+ n = num_images()
+ if (val /= (n**2 + n)/2) STOP 3
+ end if
+ end subroutine test_sum
+end program test
diff --git a/gcc/testsuite/gfortran.dg/caf-shared/collectives_2.f90 b/gcc/testsuite/gfortran.dg/caf-shared/collectives_2.f90
new file mode 100644
index 00000000000..8898250f5a7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/caf-shared/collectives_2.f90
@@ -0,0 +1,76 @@
+! { dg-do run }
+! { dg-set-target-env-var GFORTRAN_NUM_IMAGES "4" }
+! CO_SUM/CO_MIN/CO_MAX
+!
+program test
+ implicit none
+ intrinsic co_max
+ intrinsic co_min
+ intrinsic co_sum
+ integer :: val(3), tmp_val(3)
+ integer :: vec(3)
+ vec = [2,3,1]
+ if (this_image() == 1) then
+ val(1) = 42
+ else
+ val(1) = -99
+ endif
+ val(2) = this_image()
+ if (this_image() == num_images()) then
+ val(3) = -55
+ else
+ val(3) = 101
+ endif
+ tmp_val = val
+ call test_min
+ val = tmp_val
+ call test_max
+ val = tmp_val
+ call test_sum
+contains
+ subroutine test_max
+ integer :: tmp
+ call co_max (val(::2))
+ if (num_images() > 1) then
+ if (any (val /= [42, this_image(), 101])) STOP 1
+ else
+ if (any (val /= [42, this_image(), -55])) STOP 2
+ endif
+
+ val = tmp_val
+ call co_max (val(:))
+ if (num_images() > 1) then
+ if (any (val /= [42, num_images(), 101])) STOP 3
+ else
+ if (any (val /= [42, num_images(), -55])) STOP 4
+ endif
+ end subroutine test_max
+
+ subroutine test_min
+ call co_min (val, result_image=num_images())
+ if (this_image() == num_images()) then
+ !write(*,*) "Minimal value", val
+ if (num_images() > 1) then
+ if (any (val /= [-99, 1, -55])) STOP 5
+ else
+ if (any (val /= [42, 1, -55])) STOP 6
+ endif
+ else
+ if (any (val /= tmp_val)) STOP 7
+ endif
+ end subroutine test_min
+
+ subroutine test_sum
+ integer :: n
+ n = 88
+ call co_sum (val, result_image=1, stat=n)
+ if (n /= 0) STOP 8
+ if (this_image() == 1) then
+ n = num_images()
+ !write(*,*) "The sum is ", val
+ if (any (val /= [42 + (n-1)*(-99), (n**2 + n)/2, -55+(n-1)*101])) STOP 9
+ else
+ if (any (val /= tmp_val)) STOP 10
+ end if
+ end subroutine test_sum
+end program test
diff --git a/gcc/testsuite/gfortran.dg/caf-shared/collectives_4.f90 b/gcc/testsuite/gfortran.dg/caf-shared/collectives_4.f90
new file mode 100644
index 00000000000..92f1ef2b669
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/caf-shared/collectives_4.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+! { dg-set-target-env-var GFORTRAN_NUM_IMAGES "4" }
+! CO_REDUCE
+!
+implicit none (type, external)
+intrinsic :: co_reduce
+integer :: stat
+integer :: i4, i4_2, i
+
+i4 = 21 * this_image()
+i4_2 = 21
+do i = 2, num_images()
+ i4_2 = i4_2 * 21 * i
+end do
+call co_reduce(i4, op_i4, stat=stat)
+if (stat /= 0) STOP 1
+if (i4_2 /= i4) STOP 2
+
+contains
+ pure integer function op_i4(a,b)
+ integer, value :: a, b
+ op_i4 = a * b
+ end function op_i4
+end
diff --git a/gcc/testsuite/gfortran.dg/caf-shared/cosubscript_1.f90 b/gcc/testsuite/gfortran.dg/caf-shared/cosubscript_1.f90
new file mode 100644
index 00000000000..65377f19e48
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/caf-shared/cosubscript_1.f90
@@ -0,0 +1,67 @@
+! { dg-do run }
+! { dg-set-target-env-var GFORTRAN_NUM_IMAGES "4" }
+!
+! From the HPCTools Group of University of Houston
+!
+! For a coindexed object, its cosubscript list determines the image
+! index in the same way that a subscript list determines the subscript
+! order value for an array element
+
+! Run at least with 3 images for the normal checking code
+! Modified to also accept a single or two images
+program cosubscript_test
+ implicit none
+
+ integer, parameter :: X = 3, Y = 2
+ integer, parameter :: P = 1, Q = -1
+ integer :: me
+ integer :: i,j,k
+
+ integer :: scalar[0:P, -1:Q, *]
+
+ integer :: dim3_max, counter
+ logical :: is_err
+
+ is_err = .false.
+ me = this_image()
+ scalar = me
+ dim3_max = num_images() / ( (P+1)*(Q+2) )
+
+ sync all
+
+ if (num_images() == 1) then
+ k = 1
+ j = -1
+ i = 0
+ if (scalar[i,j,k] /= this_image()) STOP 1
+ stop "OK"
+ else if (num_images() == 2) then
+ k = 1
+ j = -1
+ counter = 0
+ do i = 0,P
+ counter = counter+1
+ if (counter /= scalar[i,j,k]) STOP 1
+ end do
+ stop "OK"
+ end if
+
+ ! ******* SCALAR ***********
+ counter = 0
+ do k = 1, dim3_max
+ do j = -1,Q
+ do i = 0,P
+ counter = counter+1
+ if (counter /= scalar[i,j,k]) then
+ print * , "Error in cosubscript translation scalar"
+ print * , "[", i,",",j,",",k,"] = ",scalar[i,j,k],"/=",counter
+ is_err = .true.
+ end if
+ end do
+ end do
+ end do
+
+ if (is_err) then
+ STOP 2
+ end if
+end program cosubscript_test
diff --git a/gcc/testsuite/gfortran.dg/caf-shared/data_1.f90 b/gcc/testsuite/gfortran.dg/caf-shared/data_1.f90
new file mode 100644
index 00000000000..d68ac14bc18
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/caf-shared/data_1.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+!
+! PR fortran/71068
+!
+! Contributed by Gerhard Steinmetz
+!
+program p
+ integer :: a(2)[*]
+ data a(1)[1] /1/ ! { dg-error "cannot have a coindex" }
+ data a(2)[1] /2/ ! { dg-error "cannot have a coindex" }
+end
diff --git a/gcc/testsuite/gfortran.dg/caf-shared/dummy_1.f90 b/gcc/testsuite/gfortran.dg/caf-shared/dummy_1.f90
new file mode 100644
index 00000000000..49531279927
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/caf-shared/dummy_1.f90
@@ -0,0 +1,70 @@
+! { dg-do run }
+! { dg-set-target-env-var GFORTRAN_NUM_IMAGES "2" }
+! PR fortran/18918
+!
+! Check whether assumed-shape's cobounds are properly handled
+!
+ implicit none
+ integer :: B(1)[*]
+ integer :: C(8:11)[-3:10,43:*]
+ integer, allocatable :: D(:)[:,:]
+
+ allocate (D(20)[2:3,5:*])
+
+ call sub (B,5)
+ call sub (C,3)
+ call sub (D,3)
+
+ call sub2 (B, -3)
+ call sub2 (C, 44)
+ call sub2 (D, 44)
+
+ call sub3 (B)
+ call sub3 (C)
+ call sub3 (D)
+
+ call sub4 (B)
+ call sub4 (C)
+ call sub4 (D)
+
+ call sub5 (D)
+ contains
+
+ subroutine sub(A,n)
+ integer :: n
+ integer :: A(n:)[n:2*n,3*n:*]
+ if (lbound(A,dim=1) /= n) STOP 1
+ if (any (lcobound(A) /= [n, 3*n])) STOP 2
+ if (ucobound(A, dim=1) /= 2*n) STOP 3
+ end subroutine sub
+
+ subroutine sub2(A,n)
+ integer :: n
+ integer :: A(:)[-n:*]
+ if (lbound(A,dim=1) /= 1) STOP 4
+ if (lcobound(A, dim=1) /= -n) STOP 5
+ end subroutine sub2
+
+ subroutine sub3(A)
+ integer :: A(:)[0,*]
+ if (lbound(A,dim=1) /= 1) STOP 6
+ if (lcobound(A, dim=1) /= 1) STOP 7
+ if (ucobound(A, dim=1) /= 0) STOP 8
+ if (lcobound(A, dim=2) /= 1) STOP 9
+ end subroutine sub3
+
+ subroutine sub4(A)
+ integer :: A(:)[*]
+ if (lbound(A,dim=1) /= 1) STOP 10
+ if (lcobound(A, dim=1) /= 1) STOP 11
+ end subroutine sub4
+
+ subroutine sub5(A)
+ integer, allocatable :: A(:)[:,:]
+
+ if (lbound(A,dim=1) /= 1) STOP 12
+ if (lcobound(A, dim=1) /= 2) STOP 13
+ if (ucobound(A, dim=1) /= 3) STOP 14
+ if (lcobound(A, dim=2) /= 5) STOP 15
+ end subroutine sub5
+ end
diff --git a/gcc/testsuite/gfortran.dg/caf-shared/image_index_2.f90 b/gcc/testsuite/gfortran.dg/caf-shared/image_index_2.f90
new file mode 100644
index 00000000000..2d4b1067555
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/caf-shared/image_index_2.f90
@@ -0,0 +1,77 @@
+! { dg-do run }
+! { dg-set-target-env-var GFORTRAN_NUM_IMAGES "4" }
+
+! Scalar coarray
+!
+! Run-time test for IMAGE_INDEX with cobounds only known at
+! the compile time, suitable for any number of NUM_IMAGES()
+! For compile-time cobounds, the -fcoarray=lib version still
+! needs to run-time evalulation if image_index returns > 1
+! as image_index is 0 if the index would exceed num_images().
+!
+! Please set num_images() to >= 13, if possible.
+!
+! PR fortran/18918
+!
+
+program test_image_index
+implicit none
+integer :: index1, index2, index3
+logical :: one
+
+integer, save :: d[-1:3, *]
+integer, save :: e[-1:-1, 3:*]
+
+one = num_images() == 1
+
+index1 = image_index(d, [-1, 1] )
+index2 = image_index(d, [0, 1] )
+
+if (one .and. (index1 /= 1 .or. index2 /= 0)) &
+ STOP 1
+if (.not. one .and. (index1 /= 1 .or. index2 /= 2)) &
+ STOP 2
+
+index1 = image_index(e, [-1, 3] )
+index2 = image_index(e, [-1, 4] )
+
+if (one .and. (index1 /= 1 .or. index2 /= 0)) &
+ STOP 3
+if (.not. one .and. (index1 /= 1 .or. index2 /= 2)) &
+ STOP 4
+
+call test(1, e, d, e)
+call test(2, e, d, e)
+
+contains
+subroutine test(n, a, b, c)
+ integer :: n
+ integer :: a[3*n:3*n, -4*n:-3*n, 88*n:*], b[-1*n:0*n,0*n:*], c[*]
+
+ index1 = image_index(a, [3*n, -4*n, 88*n] )
+ index2 = image_index(b, [-1, 0] )
+ index3 = image_index(c, [1] )
+
+ if (n == 1) then
+ if (index1 /= 1 .or. index2 /= 1 .or. index3 /= 1) STOP 5
+ else if (num_images() == 1) then
+ if (index1 /= 1 .or. index2 /= 0 .or. index3 /= 1) STOP 6
+ else
+ if (index1 /= 1 .or. index2 /= 2 .or. index3 /= 1) STOP 7
+ end if
+
+ index1 = image_index(a, [3*n, -3*n, 88*n] )
+ index2 = image_index(b, [0, 0] )
+ index3 = image_index(c, [2] )
+
+ if (one .and. (index1 /= 0 .or. index2 /= 0 .or. index3 /= 0)) &
+ STOP 8
+ if (n == 1 .and. num_images() == 2) then
+ if (index1 /= 2 .or. index2 /= 2 .or. index3 /= 2) &
+ STOP 9
+ else if (n == 2 .and. num_images() == 2) then
+ if (index1 /= 0 .or. index2 /= 0 .or. index3 /= 2) &
+ STOP 10
+ end if
+end subroutine test
+end program test_image_index
diff --git a/gcc/testsuite/gfortran.dg/caf-shared/num_images_1.f90 b/gcc/testsuite/gfortran.dg/caf-shared/num_images_1.f90
new file mode 100644
index 00000000000..a07dfd77a19
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/caf-shared/num_images_1.f90
@@ -0,0 +1,7 @@
+! { dg-do run }
+! { dg-set-target-env-var GFORTRAN_NUM_IMAGES "2" }
+program main
+ implicit none
+ if (num_images() /= 2) stop 1
+end program main
+
diff --git a/gcc/testsuite/gfortran.dg/caf-shared/subobject_1.f90 b/gcc/testsuite/gfortran.dg/caf-shared/subobject_1.f90
new file mode 100644
index 00000000000..5ce3c970c19
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/caf-shared/subobject_1.f90
@@ -0,0 +1,43 @@
+! { dg-do run }
+! { dg-set-target-env-var GFORTRAN_NUM_IMAGES "2" }
+! PR fortran/50420
+! Coarray subobjects were not accepted as valid coarrays
+
+ integer :: i
+ integer, parameter :: la = 4, lb = 5, lc = 8
+ integer, parameter :: init(la) = -4 + (/ (i, i=1,la) /)
+
+ type t
+ integer :: i
+ end type t
+ type t2
+ type(t), allocatable :: a[:]
+ end type t2
+ type t3
+ type(t), allocatable :: a(:)[:]
+ end type t3
+
+ type(t2) :: b
+ type(t3) :: c
+
+ allocate(b%a[lb:*])
+ b%a%i = 7
+ if (b%a%i /= 7) STOP 1
+ if (any (lcobound(b%a) /= (/ lb /))) STOP 2
+ if (ucobound(b%a, dim=1) /= num_images() + lb - 1) STOP 3
+ if (any (lcobound(b%a%i) /= (/ lb /))) STOP 4
+ if (ucobound(b%a%i, dim=1) /= num_images() + lb - 1) STOP 5
+ allocate(c%a(la)[lc:*])
+ c%a%i = init
+ if (any(c%a%i /= init)) STOP 6
+ if (any (lcobound(c%a) /= (/ lc /))) STOP 7
+ if (ucobound(c%a, dim=1) /= num_images() + lc - 1) STOP 8
+ if (any (lcobound(c%a%i) /= (/ lc /))) STOP 9
+ if (ucobound(c%a%i, dim=1) /= num_images() + lc - 1) STOP 10
+ if (c%a(2)%i /= init(2)) STOP 11
+ if (any (lcobound(c%a(2)) /= (/ lc /))) STOP 12
+ if (ucobound(c%a(2), dim=1) /= num_images() + lc - 1) STOP 13
+ if (any (lcobound(c%a(2)%i) /= (/ lc /))) STOP 14
+ if (ucobound(c%a(2)%i, dim=1) /= num_images() + lc - 1) STOP 15
+ deallocate(b%a, c%a)
+end
diff --git a/gcc/testsuite/gfortran.dg/caf-shared/this_image_1.f90 b/gcc/testsuite/gfortran.dg/caf-shared/this_image_1.f90
new file mode 100644
index 00000000000..e2906fec7e2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/caf-shared/this_image_1.f90
@@ -0,0 +1,197 @@
+! { dg-do run }
+! { dg-set-target-env-var GFORTRAN_NUM_IMAGES "4" }
+
+! PR fortran/18918
+!
+! this_image(coarray) run test,
+! expecially for num_images > 1
+!
+! Tested are values up to num_images == 8,
+! higher values are OK, but not tested for
+!
+implicit none
+integer :: a(1)[2:2, 3:4, 7:*]
+integer :: b(:)[:, :,:]
+allocatable :: b
+integer :: i
+
+if (this_image(A, dim=1) /= 2) STOP 1
+i = 1
+if (this_image(A, dim=i) /= 2) STOP 2
+
+select case (this_image())
+ case (1)
+ if (this_image(A, dim=2) /= 3) STOP 3
+ if (this_image(A, dim=3) /= 7) STOP 4
+ i = 2
+ if (this_image(A, dim=i) /= 3) STOP 5
+ i = 3
+ if (this_image(A, dim=i) /= 7) STOP 6
+ if (any (this_image(A) /= [2,3,7])) STOP 7
+
+ case (2)
+ if (this_image(A, dim=2) /= 4) STOP 8
+ if (this_image(A, dim=3) /= 7) STOP 9
+ i = 2
+ if (this_image(A, dim=i) /= 4) STOP 10
+ i = 3
+ if (this_image(A, dim=i) /= 7) STOP 11
+ if (any (this_image(A) /= [2,4,7])) STOP 12
+
+ case (3)
+ if (this_image(A, dim=2) /= 3) STOP 13
+ if (this_image(A, dim=3) /= 8) STOP 14
+ i = 2
+ if (this_image(A, dim=i) /= 3) STOP 15
+ i = 3
+ if (this_image(A, dim=i) /= 8) STOP 16
+ if (any (this_image(A) /= [2,3,8])) STOP 17
+
+ case (4)
+ if (this_image(A, dim=2) /= 4) STOP 18
+ if (this_image(A, dim=3) /= 8) STOP 19
+ i = 2
+ if (this_image(A, dim=i) /= 4) STOP 20
+ i = 3
+ if (this_image(A, dim=i) /= 8) STOP 21
+ if (any (this_image(A) /= [2,4,8])) STOP 22
+
+ case (5)
+ if (this_image(A, dim=2) /= 3) STOP 23
+ if (this_image(A, dim=3) /= 9) STOP 24
+ i = 2
+ if (this_image(A, dim=i) /= 3) STOP 25
+ i = 3
+ if (this_image(A, dim=i) /= 9) STOP 26
+ if (any (this_image(A) /= [2,3,9])) STOP 27
+
+ case (6)
+ if (this_image(A, dim=2) /= 4) STOP 28
+ if (this_image(A, dim=3) /= 9) STOP 29
+ i = 2
+ if (this_image(A, dim=i) /= 4) STOP 30
+ i = 3
+ if (this_image(A, dim=i) /= 9) STOP 31
+ if (any (this_image(A) /= [2,4,9])) STOP 32
+
+ case (7)
+ if (this_image(A, dim=2) /= 3) STOP 33
+ if (this_image(A, dim=3) /= 10) STOP 34
+ i = 2
+ if (this_image(A, dim=i) /= 3) STOP 35
+ i = 3
+ if (this_image(A, dim=i) /= 10) STOP 36
+ if (any (this_image(A) /= [2,3,10])) STOP 37
+
+ case (8)
+ if (this_image(A, dim=2) /= 4) STOP 38
+ if (this_image(A, dim=3) /= 10) STOP 39
+ i = 2
+ if (this_image(A, dim=i) /= 4) STOP 40
+ i = 3
+ if (this_image(A, dim=i) /= 10) STOP 41
+ if (any (this_image(A) /= [2,4,10])) STOP 42
+end select
+
+
+allocate (b(3)[-1:0,2:4,*])
+
+select case (this_image())
+ case (1)
+ if (this_image(B, dim=1) /= -1) STOP 43
+ if (this_image(B, dim=2) /= 2) STOP 44
+ if (this_image(B, dim=3) /= 1) STOP 45
+ i = 1
+ if (this_image(B, dim=i) /= -1) STOP 46
+ i = 2
+ if (this_image(B, dim=i) /= 2) STOP 47
+ i = 3
+ if (this_image(B, dim=i) /= 1) STOP 48
+ if (any (this_image(B) /= [-1,2,1])) STOP 49
+
+ case (2)
+ if (this_image(B, dim=1) /= 0) STOP 50
+ if (this_image(B, dim=2) /= 2) STOP 51
+ if (this_image(B, dim=3) /= 1) STOP 52
+ i = 1
+ if (this_image(B, dim=i) /= 0) STOP 53
+ i = 2
+ if (this_image(B, dim=i) /= 2) STOP 54
+ i = 3
+ if (this_image(B, dim=i) /= 1) STOP 55
+ if (any (this_image(B) /= [0,2,1])) STOP 56
+
+ case (3)
+ if (this_image(B, dim=1) /= -1) STOP 57
+ if (this_image(B, dim=2) /= 3) STOP 58
+ if (this_image(B, dim=3) /= 1) STOP 59
+ i = 1
+ if (this_image(B, dim=i) /= -1) STOP 60
+ i = 2
+ if (this_image(B, dim=i) /= 3) STOP 61
+ i = 3
+ if (this_image(B, dim=i) /= 1) STOP 62
+ if (any (this_image(B) /= [-1,3,1])) STOP 63
+
+ case (4)
+ if (this_image(B, dim=1) /= 0) STOP 64
+ if (this_image(B, dim=2) /= 3) STOP 65
+ if (this_image(B, dim=3) /= 1) STOP 66
+ i = 1
+ if (this_image(B, dim=i) /= 0) STOP 67
+ i = 2
+ if (this_image(B, dim=i) /= 3) STOP 68
+ i = 3
+ if (this_image(B, dim=i) /= 1) STOP 69
+ if (any (this_image(B) /= [0,3,1])) STOP 70
+
+ case (5)
+ if (this_image(B, dim=1) /= -1) STOP 71
+ if (this_image(B, dim=2) /= 4) STOP 72
+ if (this_image(B, dim=3) /= 1) STOP 73
+ i = 1
+ if (this_image(B, dim=i) /= -1) STOP 74
+ i = 2
+ if (this_image(B, dim=i) /= 4) STOP 75
+ i = 3
+ if (this_image(B, dim=i) /= 1) STOP 76
+ if (any (this_image(B) /= [-1,4,1])) STOP 77
+
+ case (6)
+ if (this_image(B, dim=1) /= 0) STOP 78
+ if (this_image(B, dim=2) /= 4) STOP 79
+ if (this_image(B, dim=3) /= 1) STOP 80
+ i = 1
+ if (this_image(B, dim=i) /= 0) STOP 81
+ i = 2
+ if (this_image(B, dim=i) /= 4) STOP 82
+ i = 3
+ if (this_image(B, dim=i) /= 1) STOP 83
+ if (any (this_image(B) /= [0,4,1])) STOP 84
+
+ case (7)
+ if (this_image(B, dim=1) /= -1) STOP 85
+ if (this_image(B, dim=2) /= 2) STOP 86
+ if (this_image(B, dim=3) /= 2) STOP 87
+ i = 1
+ if (this_image(B, dim=i) /= -1) STOP 88
+ i = 2
+ if (this_image(B, dim=i) /= 2) STOP 89
+ i = 3
+ if (this_image(B, dim=i) /= 2) STOP 90
+ if (any (this_image(B) /= [-1,2,2])) STOP 91
+
+ case (8)
+ if (this_image(B, dim=1) /= 0) STOP 92
+ if (this_image(B, dim=2) /= 2) STOP 93
+ if (this_image(B, dim=3) /= 2) STOP 94
+ i = 1
+ if (this_image(B, dim=i) /= 0) STOP 95
+ i = 2
+ if (this_image(B, dim=i) /= 2) STOP 96
+ i = 3
+ if (this_image(B, dim=i) /= 2) STOP 97
+ if (any (this_image(B) /= [0,2,2])) STOP 98
+end select
+
+end
diff --git a/gcc/testsuite/gfortran.dg/caf-shared/this_image_2.f90 b/gcc/testsuite/gfortran.dg/caf-shared/this_image_2.f90
new file mode 100644
index 00000000000..0ae2b9e6bdf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/caf-shared/this_image_2.f90
@@ -0,0 +1,125 @@
+! { dg-do run }
+! { dg-set-target-env-var GFORTRAN_NUM_IMAGES "8" }
+! PR fortran/18918
+!
+! Version for scalar coarrays
+!
+! this_image(coarray) run test,
+! expecially for num_images > 1
+!
+! Tested are values up to num_images == 8,
+! higher values are OK, but not tested for
+!
+implicit none
+integer :: a[2:2, 3:4, 7:*]
+integer :: i
+
+if (this_image(A, dim=1) /= 2) STOP 1
+i = 1
+if (this_image(A, dim=i) /= 2) STOP 2
+
+select case (this_image())
+ case (1)
+ if (this_image(A, dim=2) /= 3) STOP 3
+ if (this_image(A, dim=3) /= 7) STOP 4
+ i = 2
+ if (this_image(A, dim=i) /= 3) STOP 5
+ i = 3
+ if (this_image(A, dim=i) /= 7) STOP 6
+ if (any (this_image(A) /= [2,3,7])) STOP 7
+
+ case (2)
+ if (this_image(A, dim=2) /= 4) STOP 8
+ if (this_image(A, dim=3) /= 7) STOP 9
+ i = 2
+ if (this_image(A, dim=i) /= 4) STOP 10
+ i = 3
+ if (this_image(A, dim=i) /= 7) STOP 11
+ if (any (this_image(A) /= [2,4,7])) STOP 12
+
+ case (3)
+ if (this_image(A, dim=2) /= 3) STOP 13
+ if (this_image(A, dim=3) /= 8) STOP 14
+ i = 2
+ if (this_image(A, dim=i) /= 3) STOP 15
+ i = 3
+ if (this_image(A, dim=i) /= 8) STOP 16
+ if (any (this_image(A) /= [2,3,8])) STOP 17
+
+ case (4)
+ if (this_image(A, dim=2) /= 4) STOP 18
+ if (this_image(A, dim=3) /= 8) STOP 19
+ i = 2
+ if (this_image(A, dim=i) /= 4) STOP 20
+ i = 3
+ if (this_image(A, dim=i) /= 8) STOP 21
+ if (any (this_image(A) /= [2,4,8])) STOP 22
+
+ case (5)
+ if (this_image(A, dim=2) /= 3) STOP 23
+ if (this_image(A, dim=3) /= 9) STOP 24
+ i = 2
+ if (this_image(A, dim=i) /= 3) STOP 25
+ i = 3
+ if (this_image(A, dim=i) /= 9) STOP 26
+ if (any (this_image(A) /= [2,3,9])) STOP 27
+
+ case (6)
+ if (this_image(A, dim=2) /= 4) STOP 28
+ if (this_image(A, dim=3) /= 9) STOP 29
+ i = 2
+ if (this_image(A, dim=i) /= 4) STOP 30
+ i = 3
+ if (this_image(A, dim=i) /= 9) STOP 31
+ if (any (this_image(A) /= [2,4,9])) STOP 32
+
+ case (7)
+ if (this_image(A, dim=2) /= 3) STOP 33
+ if (this_image(A, dim=3) /= 10) STOP 34
+ i = 2
+ if (this_image(A, dim=i) /= 3) STOP 35
+ i = 3
+ if (this_image(A, dim=i) /= 10) STOP 36
+ if (any (this_image(A) /= [2,3,10])) STOP 37
+
+ case (8)
+ if (this_image(A, dim=2) /= 4) STOP 38
+ if (this_image(A, dim=3) /= 10) STOP 39
+ i = 2
+ if (this_image(A, dim=i) /= 4) STOP 40
+ i = 3
+ if (this_image(A, dim=i) /= 10) STOP 41
+ if (any (this_image(A) /= [2,4,10])) STOP 42
+end select
+
+contains
+
+subroutine test_image_index
+implicit none
+integer :: index1, index2, index3
+logical :: one
+
+integer, save :: d(2)[-1:3, *]
+integer, save :: e(2)[-1:-1, 3:*]
+
+one = num_images() == 1
+
+index1 = image_index(d, [-1, 1] )
+index2 = image_index(d, [0, 1] )
+
+if (one .and. (index1 /= 1 .or. index2 /= 0)) &
+ STOP 43
+if (.not. one .and. (index1 /= 1 .or. index2 /= 2)) &
+ STOP 44
+
+index1 = image_index(e, [-1, 3] )
+index2 = image_index(e, [-1, 4] )
+
+if (one .and. (index1 /= 1 .or. index2 /= 0)) &
+ STOP 45
+if (.not. one .and. (index1 /= 1 .or. index2 /= 2)) &
+ STOP 46
+
+end subroutine test_image_index
+
+end
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2020-12-06 12:28 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-12-06 12:28 [gcc/devel/coarray_native] Add caf-shared subdirectory to gfortran.dg with passing tests 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).