1! { 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
15program test_image_index
16implicit none
17integer :: index1, index2, index3
18logical :: one
19
20integer, allocatable :: a(:)[:,:,:], b(:)[:,:], c(:,:)[:]
21integer, save :: d(2)[-1:3, *]
22integer, save :: e(2)[-1:-1, 3:*]
23
24one = num_images() == 1
25
26allocate(a(1)[3:3, -4:-3, 88:*])
27allocate(b(2)[-1:0,0:*])
28allocate(c(3,3)[*])
29
30index1 = image_index(a, [3, -4, 88] )
31index2 = image_index(b, [-1, 0] )
32index3 = image_index(c, [1] )
33if (index1 /= 1 .or. index2 /= 1 .or. index3 /= 1) STOP 1
34
35
36index1 = image_index(a, [3, -3, 88] )
37index2 = image_index(b, [0, 0] )
38index3 = image_index(c, [2] )
39
40if (one .and. (index1 /= 0 .or. index2 /= 0 .or. index3 /= 0)) &
41  STOP 2
42if (.not. one .and. (index1 /= 2 .or. index2 /= 2 .or. index3 /= 2)) &
43  STOP 3
44
45
46index1 = image_index(d, [-1, 1] )
47index2 = image_index(d, [0, 1] )
48
49if (one .and. (index1 /= 1 .or. index2 /= 0)) &
50  STOP 4
51if (.not. one .and. (index1 /= 1 .or. index2 /= 2)) &
52  STOP 5
53
54index1 = image_index(e, [-1, 3] )
55index2 = image_index(e, [-1, 4] )
56
57if (one .and. (index1 /= 1 .or. index2 /= 0)) &
58  STOP 6
59if (.not. one .and. (index1 /= 1 .or. index2 /= 2)) &
60  STOP 7
61
62call test(1, a,b,c)
63
64! The following test is in honour of the F2008 standard:
65deallocate(a)
66allocate(a (10) [10, 0:9, 0:*])
67
68index1 = image_index(a, [1, 0, 0] )
69index2 = image_index(a, [3, 1, 2] )  ! = 213, yeah!
70index3 = image_index(a, [3, 1, 0] )  ! = 13
71
72if (num_images() < 13 .and. (index1 /= 1 .or. index2 /= 0 .or. index3 /= 0)) &
73  STOP 8
74if (num_images() >= 213 .and. (index1 /= 1 .or. index2 /= 213 .or. index3 /= 13)) &
75  STOP 9
76if (num_images() >= 13 .and. (index1 /= 1 .or. index2 /= 0 .or. index3 /= 13)) &
77  STOP 10
78
79
80contains
81subroutine 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) STOP 11
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    STOP 12
97  if (.not. one .and. (index1 /= 2 .or. index2 /= 2 .or. index3 /= 2)) &
98    STOP 13
99end subroutine test
100end program test_image_index
101