1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
! { dg-do run }
!
! 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
|
