From b0d1c284ed027110200748945495cef172f5a93d Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Tue, 3 May 2011 23:35:44 +0200 Subject: [PATCH] re PR fortran/18918 (Eventually support Fortran 2008's coarrays [co-arrays]) 2011-05-03 Tobias Burnus PR fortran/18918 * gfortran.dg/coarray/caf.dg: New. * gfortran.dg/coarray/image_index_1.f90: New, copied from ../coarray_16.f90. From-SVN: r173341 --- gcc/testsuite/ChangeLog | 7 ++ gcc/testsuite/gfortran.dg/coarray/caf.exp | 76 ++++++++++++++ .../gfortran.dg/coarray/image_index_1.f90 | 99 +++++++++++++++++++ 3 files changed, 182 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/coarray/caf.exp create mode 100644 gcc/testsuite/gfortran.dg/coarray/image_index_1.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 332b2092bbd..5ce6d37ad1c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2011-05-03 Tobias Burnus + + PR fortran/18918 + * gfortran.dg/coarray/caf.dg: New. + * gfortran.dg/coarray/image_index_1.f90: New, copied + from ../coarray_16.f90. + 2011-05-03 Paolo Carlini PR c++/28501 diff --git a/gcc/testsuite/gfortran.dg/coarray/caf.exp b/gcc/testsuite/gfortran.dg/coarray/caf.exp new file mode 100644 index 00000000000..c7e46f6bedc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray/caf.exp @@ -0,0 +1,76 @@ +# Copyright (C) 2011 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 +# . +# +# Contributed by Tobias Burnus + + +# Test coarray support. +# +# For the compilation tests, all files are compiles with the +# option -fcoarray=single and with -fcoarray=lib +# +# For the link and execution tests, for -fcoarray=lib the +# libcaf_single library is linked. Additionally, with the +# required settings another CAF library is used. + +# Load procedures from common libraries. +load_lib gfortran-dg.exp + +# If a testcase doesn't have special options, use these. +global DEFAULT_FFLAGS +if ![info exists DEFAULT_FFLAGS] then { + set DEFAULT_FFLAGS " -pedantic-errors" +} + +dg-init + +global runtests +global DG_TORTURE_OPTIONS torture_with_loops + +torture-init +set-torture-options $DG_TORTURE_OPTIONS + +# 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 + } + +# Enable if you want to test several options: +# # look if this is dg-do-run test, in which case +# # we cycle through the option list, otherwise we don't +# if [expr [search_for $test "dg-do run"]] { +# set option_list $torture_with_loops +# } else { +# set option_list [list { -O } ] +# } + set option_list [list { -O2 } ] + + set nshort [file tail [file dirname $test]]/[file tail $test] + + foreach flags $option_list { + verbose "Testing $nshort (single), $flags" 1 + dg-test $test "-fcoarray=single $flags" "" + } + + foreach flags $option_list { + verbose "Testing $nshort (libcaf_single), $flags" 1 + dg-test $test "-fcoarray=lib $flags -lcaf_single" "" + } +} +torture-finish +dg-finish diff --git a/gcc/testsuite/gfortran.dg/coarray/image_index_1.f90 b/gcc/testsuite/gfortran.dg/coarray/image_index_1.f90 new file mode 100644 index 00000000000..00e5e09a74f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray/image_index_1.f90 @@ -0,0 +1,99 @@ +! { dg-do run } +! +! 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, allocatable :: a(:)[:,:,:], b(:)[:,:], c(:,:)[:] +integer, save :: d(2)[-1:3, *] +integer, save :: e(2)[-1:-1, 3:*] + +one = num_images() == 1 + +allocate(a(1)[3:3, -4:-3, 88:*]) +allocate(b(2)[-1:0,0:*]) +allocate(c(3,3)[*]) + +index1 = image_index(a, [3, -4, 88] ) +index2 = image_index(b, [-1, 0] ) +index3 = image_index(c, [1] ) +if (index1 /= 1 .or. index2 /= 1 .or. index3 /= 1) call abort() + + +index1 = image_index(a, [3, -3, 88] ) +index2 = image_index(b, [0, 0] ) +index3 = image_index(c, [2] ) + +if (one .and. (index1 /= 0 .or. index2 /= 0 .or. index3 /= 0)) & + call abort() +if (.not. one .and. (index1 /= 2 .or. index2 /= 2 .or. index3 /= 2)) & + call abort() + + +index1 = image_index(d, [-1, 1] ) +index2 = image_index(d, [0, 1] ) + +if (one .and. (index1 /= 1 .or. index2 /= 0)) & + call abort() +if (.not. one .and. (index1 /= 1 .or. index2 /= 2)) & + call abort() + +index1 = image_index(e, [-1, 3] ) +index2 = image_index(e, [-1, 4] ) + +if (one .and. (index1 /= 1 .or. index2 /= 0)) & + call abort() +if (.not. one .and. (index1 /= 1 .or. index2 /= 2)) & + call abort() + +call test(1, a,b,c) + +! The following test is in honour of the F2008 standard: +deallocate(a) +allocate(a (10) [10, 0:9, 0:*]) + +index1 = image_index(a, [1, 0, 0] ) +index2 = image_index(a, [3, 1, 2] ) ! = 213, yeah! +index3 = image_index(a, [3, 1, 0] ) ! = 13 + +if (num_images() < 13 .and. (index1 /= 1 .or. index2 /= 0 .or. index3 /= 0)) & + call abort() +if (num_images() >= 213 .and. (index1 /= 1 .or. index2 /= 213 .or. index3 /= 13)) & + call abort() +if (num_images() >= 13 .and. (index1 /= 1 .or. index2 /= 0 .or. index3 /= 13)) & + call abort() + + +contains +subroutine test(n, a, b, c) + integer :: n + integer :: a(1)[3*n:3*n, -4*n:-3*n, 88*n:*], b(2)[-1*n:0*n,0*n:*], c(3*n,3*n)[*] + + index1 = image_index(a, [3, -4, 88] ) + index2 = image_index(b, [-1, 0] ) + index3 = image_index(c, [1] ) + if (index1 /= 1 .or. index2 /= 1 .or. index3 /= 1) call abort() + + + index1 = image_index(a, [3, -3, 88] ) + index2 = image_index(b, [0, 0] ) + index3 = image_index(c, [2] ) + + if (one .and. (index1 /= 0 .or. index2 /= 0 .or. index3 /= 0)) & + call abort() + if (.not. one .and. (index1 /= 2 .or. index2 /= 2 .or. index3 /= 2)) & + call abort() +end subroutine test +end program test_image_index -- 2.30.2