gcc/testsuite/gfortran.dg/coarray_13.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fcoarray=single -fcheck=bounds" }
   3 !
   4 ! Coarray support -- allocatable array coarrays
   5 !                 -- intrinsic procedures
   6 ! PR fortran/18918
   7 ! PR fortran/43931
   8 !
   9 program test
  10   implicit none
  11   integer,allocatable :: B(:)[:]
  12
  13   call one()
  14   call two()
  15   allocate(B(3)[-4:*])
  16   call three(3,B,1)
  17   call three_a(3,B)
  18   call three_b(3,B)
  19   call four(B)
  20   call five()
  21 contains
  22   subroutine one()
  23     integer, allocatable :: a(:)[:,:,:]
  24     allocate(a(1)[-4:9,8,4:*])
  25
  26     if (this_image(a,dim=1) /= -4_8) call abort()
  27     if (lcobound  (a,dim=1) /= -4_8) call abort()
  28     if (ucobound  (a,dim=1) /=  9_8) call abort()
  29
  30     if (this_image(a,dim=2) /=  1_8) call abort()
  31     if (lcobound  (a,dim=2) /=  1_8) call abort()
  32     if (ucobound  (a,dim=2) /=  8_8) call abort()
  33
  34     if (this_image(a,dim=3) /= 4_8) call abort()
  35     if (lcobound  (a,dim=3) /= 4_8) call abort()
  36     if (ucobound  (a,dim=3) /= 4_8) call abort()
  37
  38     if (any(this_image(a) /= [-4_8, 1_8, 4_8])) call abort()
  39     if (any(lcobound  (a) /= [-4_8, 1_8, 4_8])) call abort()
  40     if (any(ucobound  (a) /= [9_8, 8_8, 4_8])) call abort()
  41   end subroutine one
  42
  43   subroutine two()
  44     integer, allocatable :: a(:)[:,:,:]
  45     allocate(a(1)[-4:9,8,4:*])
  46
  47     if (this_image(a,dim=1) /= -4) call abort()
  48     if (lcobound  (a,dim=1) /= -4) call abort()
  49     if (ucobound  (a,dim=1) /=  9) call abort()
  50
  51     if (this_image(a,dim=2) /=  1) call abort()
  52     if (lcobound  (a,dim=2) /=  1) call abort()
  53     if (ucobound  (a,dim=2) /=  8) call abort()
  54
  55     if (this_image(a,dim=3) /= 4) call abort()
  56     if (lcobound  (a,dim=3) /= 4) call abort()
  57     if (ucobound  (a,dim=3) /= 4) call abort()
  58
  59     if (any(this_image(a) /= [-4, 1, 4])) call abort()
  60     if (any(lcobound  (a) /= [-4, 1, 4])) call abort()
  61     if (any(ucobound  (a) /= [9, 8, 4])) call abort()
  62   end subroutine two
  63
  64   subroutine three(n,A, n2)
  65     integer :: n, n2
  66     integer :: A(3)[n:*]
  67
  68     A(1) = 42
  69     if (A(1) /= 42) call abort()
  70     A(1)[n2] = -42
  71     if (A(1)[n2] /= -42) call abort()
  72
  73     if (this_image(A,dim=1) /= n) call abort()
  74     if (lcobound  (A,dim=1) /= n) call abort()
  75     if (ucobound  (A,dim=1) /= n) call abort()
  76
  77     if (any(this_image(A) /= n)) call abort()
  78     if (any(lcobound  (A) /= n)) call abort()
  79     if (any(ucobound  (A) /= n)) call abort()
  80   end subroutine three
  81
  82   subroutine three_a(n,A)
  83     integer :: n
  84     integer :: A(3)[n+2:n+5,n-1:*]
  85
  86     A(1) = 42
  87     if (A(1) /= 42) call abort()
  88     A(1)[4,n] = -42
  89     if (A(1)[4,n] /= -42) call abort()
  90
  91     if (this_image(A,dim=1) /= n+2) call abort()
  92     if (lcobound  (A,dim=1) /= n+2) call abort()
  93     if (ucobound  (A,dim=1) /= n+5) call abort()
  94
  95     if (this_image(A,dim=2) /= n-1) call abort()
  96     if (lcobound  (A,dim=2) /= n-1) call abort()
  97     if (ucobound  (A,dim=2) /= n-1) call abort()
  98
  99     if (any(this_image(A) /= [n+2,n-1])) call abort()
 100     if (any(lcobound  (A) /= [n+2,n-1])) call abort()
 101     if (any(ucobound  (A) /= [n+5,n-1])) call abort()
 102   end subroutine three_a
 103
 104   subroutine three_b(n,A)
 105     integer :: n
 106     integer :: A(-1:3,0:4,-2:5,-4:7)[n+2:n+5,n-1:*]
 107
 108     A(-1,0,-2,-4) = 42
 109     if (A(-1,0,-2,-4) /= 42) call abort()
 110     A(1,0,-2,-4) = 99
 111     if (A(1,0,-2,-4) /= 99) call abort()
 112
 113     if (this_image(A,dim=1) /= n+2) call abort()
 114     if (lcobound  (A,dim=1) /= n+2) call abort()
 115     if (ucobound  (A,dim=1) /= n+5) call abort()
 116
 117     if (this_image(A,dim=2) /= n-1) call abort()
 118     if (lcobound  (A,dim=2) /= n-1) call abort()
 119     if (ucobound  (A,dim=2) /= n-1) call abort()
 120
 121     if (any(this_image(A) /= [n+2,n-1])) call abort()
 122     if (any(lcobound  (A) /= [n+2,n-1])) call abort()
 123     if (any(ucobound  (A) /= [n+5,n-1])) call abort()
 124   end subroutine three_b
 125
 126   subroutine four(A)
 127     integer, allocatable :: A(:)[:]
 128     if (this_image(A,dim=1) /= -4_8) call abort()
 129     if (lcobound  (A,dim=1) /= -4_8) call abort()
 130     if (ucobound  (A,dim=1) /= -4_8) call abort()
 131   end subroutine four
 132
 133   subroutine five()
 134     integer, save :: foo(2)[5:7,4:*]
 135     integer :: i
 136
 137     i = 1
 138     foo(1)[5,4] = 42
 139     if (foo(1)[5,4] /= 42) call abort()
 140     if (this_image(foo,dim=i) /= 5) call abort()
 141     if (lcobound(foo,dim=i) /= 5) call abort()
 142     if (ucobound(foo,dim=i) /= 7) call abort()
 143
 144     i = 2
 145     if (this_image(foo,dim=i) /= 4) call abort()
 146     if (lcobound(foo,dim=i) /= 4) call abort()
 147     if (ucobound(foo,dim=i) /= 4) call abort()
 148   end subroutine five
 149 end program test