| 1 |
694 |
jeremybenn |
! { dg-do run }
|
| 2 |
|
|
! { dg-options "-fcoarray=single" }
|
| 3 |
|
|
!
|
| 4 |
|
|
! Run-time test for IMAGE_INDEX with cobounds only known at
|
| 5 |
|
|
! the compile time, suitable for any number of NUM_IMAGES()
|
| 6 |
|
|
! For compile-time cobounds, the -fcoarray=lib version still
|
| 7 |
|
|
! needs to run-time evalulation if image_index returns > 1
|
| 8 |
|
|
! as image_index is 0 if the index would exceed num_images().
|
| 9 |
|
|
!
|
| 10 |
|
|
! Please set num_images() to >= 13, if possible.
|
| 11 |
|
|
!
|
| 12 |
|
|
! PR fortran/18918
|
| 13 |
|
|
!
|
| 14 |
|
|
|
| 15 |
|
|
program test_image_index
|
| 16 |
|
|
implicit none
|
| 17 |
|
|
integer :: index1, index2, index3
|
| 18 |
|
|
logical :: one
|
| 19 |
|
|
|
| 20 |
|
|
integer, allocatable :: a(:)[:,:,:], b(:)[:,:], c(:,:)[:]
|
| 21 |
|
|
integer, save :: d(2)[-1:3, *]
|
| 22 |
|
|
integer, save :: e(2)[-1:-1, 3:*]
|
| 23 |
|
|
|
| 24 |
|
|
one = num_images() == 1
|
| 25 |
|
|
|
| 26 |
|
|
allocate(a(1)[3:3, -4:-3, 88:*])
|
| 27 |
|
|
allocate(b(2)[-1:0,0:*])
|
| 28 |
|
|
allocate(c(3,3)[*])
|
| 29 |
|
|
|
| 30 |
|
|
index1 = image_index(a, [3, -4, 88] )
|
| 31 |
|
|
index2 = image_index(b, [-1, 0] )
|
| 32 |
|
|
index3 = image_index(c, [1] )
|
| 33 |
|
|
if (index1 /= 1 .or. index2 /= 1 .or. index3 /= 1) call abort()
|
| 34 |
|
|
|
| 35 |
|
|
|
| 36 |
|
|
index1 = image_index(a, [3, -3, 88] )
|
| 37 |
|
|
index2 = image_index(b, [0, 0] )
|
| 38 |
|
|
index3 = image_index(c, [2] )
|
| 39 |
|
|
|
| 40 |
|
|
if (one .and. (index1 /= 0 .or. index2 /= 0 .or. index3 /= 0)) &
|
| 41 |
|
|
call abort()
|
| 42 |
|
|
if (.not. one .and. (index1 /= 2 .or. index2 /= 2 .or. index3 /= 2)) &
|
| 43 |
|
|
call abort()
|
| 44 |
|
|
|
| 45 |
|
|
|
| 46 |
|
|
index1 = image_index(d, [-1, 1] )
|
| 47 |
|
|
index2 = image_index(d, [0, 1] )
|
| 48 |
|
|
|
| 49 |
|
|
if (one .and. (index1 /= 1 .or. index2 /= 0)) &
|
| 50 |
|
|
call abort()
|
| 51 |
|
|
if (.not. one .and. (index1 /= 1 .or. index2 /= 2)) &
|
| 52 |
|
|
call abort()
|
| 53 |
|
|
|
| 54 |
|
|
index1 = image_index(e, [-1, 3] )
|
| 55 |
|
|
index2 = image_index(e, [-1, 4] )
|
| 56 |
|
|
|
| 57 |
|
|
if (one .and. (index1 /= 1 .or. index2 /= 0)) &
|
| 58 |
|
|
call abort()
|
| 59 |
|
|
if (.not. one .and. (index1 /= 1 .or. index2 /= 2)) &
|
| 60 |
|
|
call abort()
|
| 61 |
|
|
|
| 62 |
|
|
call test(1, a,b,c)
|
| 63 |
|
|
|
| 64 |
|
|
! The following test is in honour of the F2008 standard:
|
| 65 |
|
|
deallocate(a)
|
| 66 |
|
|
allocate(a (10) [10, 0:9, 0:*])
|
| 67 |
|
|
|
| 68 |
|
|
index1 = image_index(a, [1, 0, 0] )
|
| 69 |
|
|
index2 = image_index(a, [3, 1, 2] ) ! = 213, yeah!
|
| 70 |
|
|
index3 = image_index(a, [3, 1, 0] ) ! = 13
|
| 71 |
|
|
|
| 72 |
|
|
if (num_images() < 13 .and. (index1 /= 1 .or. index2 /= 0 .or. index3 /= 0)) &
|
| 73 |
|
|
call abort()
|
| 74 |
|
|
if (num_images() >= 213 .and. (index1 /= 1 .or. index2 /= 213 .or. index3 /= 13)) &
|
| 75 |
|
|
call abort()
|
| 76 |
|
|
if (num_images() >= 13 .and. (index1 /= 1 .or. index2 /= 0 .or. index3 /= 13)) &
|
| 77 |
|
|
call abort()
|
| 78 |
|
|
|
| 79 |
|
|
|
| 80 |
|
|
contains
|
| 81 |
|
|
subroutine test(n, a, b, c)
|
| 82 |
|
|
integer :: n
|
| 83 |
|
|
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)[*]
|
| 84 |
|
|
|
| 85 |
|
|
index1 = image_index(a, [3, -4, 88] )
|
| 86 |
|
|
index2 = image_index(b, [-1, 0] )
|
| 87 |
|
|
index3 = image_index(c, [1] )
|
| 88 |
|
|
if (index1 /= 1 .or. index2 /= 1 .or. index3 /= 1) call abort()
|
| 89 |
|
|
|
| 90 |
|
|
|
| 91 |
|
|
index1 = image_index(a, [3, -3, 88] )
|
| 92 |
|
|
index2 = image_index(b, [0, 0] )
|
| 93 |
|
|
index3 = image_index(c, [2] )
|
| 94 |
|
|
|
| 95 |
|
|
if (one .and. (index1 /= 0 .or. index2 /= 0 .or. index3 /= 0)) &
|
| 96 |
|
|
call abort()
|
| 97 |
|
|
if (.not. one .and. (index1 /= 2 .or. index2 /= 2 .or. index3 /= 2)) &
|
| 98 |
|
|
call abort()
|
| 99 |
|
|
end subroutine test
|
| 100 |
|
|
end program test_image_index
|
