1! { dg-do run }
2!
3! Scalar coarray
4!
5! Run-time test for IMAGE_INDEX with cobounds only known at
6! the compile time, suitable for any number of NUM_IMAGES()
7! For compile-time cobounds, the -fcoarray=lib version still
8! needs to run-time evalulation if image_index returns > 1
9! as image_index is 0 if the index would exceed num_images().
10!
11! Please set num_images() to >= 13, if possible.
12!
13! PR fortran/18918
14!
15
16program test_image_index
17implicit none
18integer :: index1, index2, index3
19logical :: one
20
21integer, save :: d[-1:3, *]
22integer, save :: e[-1:-1, 3:*]
23
24one = num_images() == 1
25
26index1 = image_index(d, [-1, 1] )
27index2 = image_index(d, [0, 1] )
28
29if (one .and. (index1 /= 1 .or. index2 /= 0)) &
30  STOP 1
31if (.not. one .and. (index1 /= 1 .or. index2 /= 2)) &
32  STOP 2
33
34index1 = image_index(e, [-1, 3] )
35index2 = image_index(e, [-1, 4] )
36
37if (one .and. (index1 /= 1 .or. index2 /= 0)) &
38  STOP 3
39if (.not. one .and. (index1 /= 1 .or. index2 /= 2)) &
40  STOP 4
41
42call test(1, e, d, e)
43call test(2, e, d, e)
44
45contains
46subroutine test(n, a, b, c)
47  integer :: n
48  integer :: a[3*n:3*n, -4*n:-3*n, 88*n:*], b[-1*n:0*n,0*n:*], c[*]
49
50  index1 = image_index(a, [3*n, -4*n, 88*n] )
51  index2 = image_index(b, [-1, 0] )
52  index3 = image_index(c, [1] )
53
54  if (n == 1) then
55    if (index1 /= 1 .or. index2 /= 1 .or. index3 /= 1) STOP 5
56  else if (num_images() == 1) then
57    if (index1 /= 1 .or. index2 /= 0 .or. index3 /= 1) STOP 6
58  else
59    if (index1 /= 1 .or. index2 /= 2 .or. index3 /= 1) STOP 7
60  end if
61
62  index1 = image_index(a, [3*n, -3*n, 88*n] )
63  index2 = image_index(b, [0, 0] )
64  index3 = image_index(c, [2] )
65
66  if (one .and. (index1 /= 0 .or. index2 /= 0 .or. index3 /= 0)) &
67    STOP 8
68  if (n == 1 .and. num_images() == 2) then
69    if (index1 /= 2 .or. index2 /= 2 .or. index3 /= 2) &
70      STOP 9
71  else if (n == 2 .and. num_images() == 2) then
72    if (index1 /= 0 .or. index2 /= 0 .or. index3 /= 2) &
73      STOP 10
74  end if
75end subroutine test
76end program test_image_index
77