re PR fortran/18918 (Eventually support Fortran 2008's coarrays [co-arrays])
2011-05-03 Tobias Burnus <burnus@net-b.de>
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
This commit is contained in:
Tobias Burnus
Tobias Burnus
parent
6ac00218e1
commit
b0d1c284ed
3 changed files with 182 additions and 0 deletions
|
|
@ -1,3 +1,10 @@
|
|||
2011-05-03 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
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 <paolo.carlini@oracle.com>
|
||||
|
||||
PR c++/28501
|
||||
|
|
|
|||
76
gcc/testsuite/gfortran.dg/coarray/caf.exp
Normal file
76
gcc/testsuite/gfortran.dg/coarray/caf.exp
Normal file
|
|
@ -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
|
||||
# <http://www.gnu.org/licenses/>.
|
||||
#
|
||||
# Contributed by Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
|
||||
# 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
|
||||
99
gcc/testsuite/gfortran.dg/coarray/image_index_1.f90
Normal file
99
gcc/testsuite/gfortran.dg/coarray/image_index_1.f90
Normal file
|
|
@ -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
|
||||
Loading…
Add table
Reference in a new issue