1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
! { dg-do compile }
! { dg-options "-fcoarray=single -fdump-tree-original" }
!
! PR fortran/18918
! PR fortran/43919 for boundsTest()
!
! Coarray intrinsics
!
subroutine image_idx_test1()
INTEGER,save :: array[2,-1:4,8,*]
WRITE (*,*) IMAGE_INDEX (array, [2,0,3,1])
if (IMAGE_INDEX (array, [1,-1,1,1]) /= 1) call not_existing()
if (IMAGE_INDEX (array, [2,-1,1,1]) /= 0) call not_existing()
if (IMAGE_INDEX (array, [1,-1,1,2]) /= 0) call not_existing()
end subroutine
subroutine this_image_check()
integer,save :: a(1,2,3,5)[0:3,*]
integer :: j
if (this_image() /= 1) call not_existing()
if (this_image(a,dim=1) /= 0) call not_existing()
if (this_image(a,dim=2) /= 1) call not_existing()
end subroutine this_image_check
subroutine othercheck()
real,save :: a(5)[2,*]
complex,save :: c[4:5,6,9:*]
integer,save :: i, j[*]
dimension :: b(3)
codimension :: b[5:*]
dimension :: h(9:10)
codimension :: h[8:*]
save :: b,h
if (this_image() /= 1) call not_existing()
if (num_images() /= 1) call not_existing()
if(any(this_image(coarray=a) /= [ 1, 1 ])) call not_existing()
if(any(this_image(c) /= [4,1,9])) call not_existing()
if(this_image(c, dim=3) /= 9) call not_existing()
if(ubound(b,dim=1) /= 3 .or. this_image(coarray=b,dim=1) /= 5) call not_existing()
if(ubound(h,dim=1) /= 10 .or. this_image(h,dim=1) /= 8) call not_existing()
end subroutine othercheck
subroutine andanother()
integer,save :: a(1)[2:9,4,-3:5,0:*]
print *, lcobound(a)
print *, lcobound(a,dim=3,kind=8)
print *, ucobound(a)
print *, ucobound(a,dim=1,kind=2)
if (any(lcobound(a) /= [2, 1, -3, 0])) call not_existing()
if (any(ucobound(a) /= [9, 4, 5, 0])) call not_existing()
if (lcobound(a,dim=3,kind=8) /= -3_8) call not_existing()
if (ucobound(a,dim=1,kind=2) /= 9_2) call not_existing()
end subroutine andanother
subroutine boundsTest()
implicit none
integer :: a[*] = 7
if (any (lcobound(a) /= [1])) call not_existing()
if (any (ucobound(a) /= [1])) call not_existing()
end subroutine boundsTest
! { dg-final { scan-tree-dump-times "not_existing" 0 "original" } }
|
