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