gcc/testsuite/gfortran.dg/coarray_11.f90

   1 ! { 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" } }