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