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