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