public inbox for gcc-cvs@sourceware.org help / color / mirror / Atom feed
From: "Thomas Kथघnig" <tkoenig@gcc.gnu.org> To: gcc-cvs@gcc.gnu.org Subject: [gcc/devel/coarray_native] Add caf-shared subdirectory to gfortran.dg with passing tests. Date: Sun, 6 Dec 2020 12:28:16 +0000 (GMT) [thread overview] Message-ID: <20201206122816.E080B3857831@sourceware.org> (raw) 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
reply other threads:[~2020-12-06 12:28 UTC|newest] Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions: You may reply publicly to this message via plain-text email using any one of the following methods: * Save the following mbox file, import it into your mail client, and reply-to-all from there: mbox Avoid top-posting and favor interleaved quoting: https://en.wikipedia.org/wiki/Posting_style#Interleaved_style * Reply using the --to, --cc, and --in-reply-to switches of git-send-email(1): git send-email \ --in-reply-to=20201206122816.E080B3857831@sourceware.org \ --to=tkoenig@gcc.gnu.org \ --cc=gcc-cvs@gcc.gnu.org \ /path/to/YOUR_REPLY https://kernel.org/pub/software/scm/git/docs/git-send-email.html * If your mail client supports setting the In-Reply-To header via mailto: links, try the mailto: linkBe sure your reply has a Subject: header at the top and a blank line before the message body.
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).