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) STOP 1
  27     if (lcobound  (a,dim=1) /= -4_8) STOP 2
  28     if (ucobound  (a,dim=1) /=  9_8) STOP 3
  29
  30     if (this_image(a,dim=2) /=  1_8) STOP 4
  31     if (lcobound  (a,dim=2) /=  1_8) STOP 5
  32     if (ucobound  (a,dim=2) /=  8_8) STOP 6
  33
  34     if (this_image(a,dim=3) /= 4_8) STOP 7
  35     if (lcobound  (a,dim=3) /= 4_8) STOP 8
  36     if (ucobound  (a,dim=3) /= 4_8) STOP 9
  37
  38     if (any(this_image(a) /= [-4_8, 1_8, 4_8])) STOP 10
  39     if (any(lcobound  (a) /= [-4_8, 1_8, 4_8])) STOP 11
  40     if (any(ucobound  (a) /= [9_8, 8_8, 4_8])) STOP 12
  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) STOP 13
  48     if (lcobound  (a,dim=1) /= -4) STOP 14
  49     if (ucobound  (a,dim=1) /=  9) STOP 15
  50
  51     if (this_image(a,dim=2) /=  1) STOP 16
  52     if (lcobound  (a,dim=2) /=  1) STOP 17
  53     if (ucobound  (a,dim=2) /=  8) STOP 18
  54
  55     if (this_image(a,dim=3) /= 4) STOP 19
  56     if (lcobound  (a,dim=3) /= 4) STOP 20
  57     if (ucobound  (a,dim=3) /= 4) STOP 21
  58
  59     if (any(this_image(a) /= [-4, 1, 4])) STOP 22
  60     if (any(lcobound  (a) /= [-4, 1, 4])) STOP 23
  61     if (any(ucobound  (a) /= [9, 8, 4])) STOP 24
  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) STOP 25
  70     A(1)[n2] = -42
  71     if (A(1)[n2] /= -42) STOP 26
  72
  73     if (this_image(A,dim=1) /= n) STOP 27
  74     if (lcobound  (A,dim=1) /= n) STOP 28
  75     if (ucobound  (A,dim=1) /= n) STOP 29
  76
  77     if (any(this_image(A) /= n)) STOP 30
  78     if (any(lcobound  (A) /= n)) STOP 31
  79     if (any(ucobound  (A) /= n)) STOP 32
  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) STOP 33
  88     A(1)[4,n] = -42
  89     if (A(1)[4,n] /= -42) STOP 34
  90
  91     if (this_image(A,dim=1) /= n+2) STOP 35
  92     if (lcobound  (A,dim=1) /= n+2) STOP 36
  93     if (ucobound  (A,dim=1) /= n+5) STOP 37
  94
  95     if (this_image(A,dim=2) /= n-1) STOP 38
  96     if (lcobound  (A,dim=2) /= n-1) STOP 39
  97     if (ucobound  (A,dim=2) /= n-1) STOP 40
  98
  99     if (any(this_image(A) /= [n+2,n-1])) STOP 41
 100     if (any(lcobound  (A) /= [n+2,n-1])) STOP 42
 101     if (any(ucobound  (A) /= [n+5,n-1])) STOP 43
 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) STOP 44
 110     A(1,0,-2,-4) = 99
 111     if (A(1,0,-2,-4) /= 99) STOP 45
 112
 113     if (this_image(A,dim=1) /= n+2) STOP 46
 114     if (lcobound  (A,dim=1) /= n+2) STOP 47
 115     if (ucobound  (A,dim=1) /= n+5) STOP 48
 116
 117     if (this_image(A,dim=2) /= n-1) STOP 49
 118     if (lcobound  (A,dim=2) /= n-1) STOP 50
 119     if (ucobound  (A,dim=2) /= n-1) STOP 51
 120
 121     if (any(this_image(A) /= [n+2,n-1])) STOP 52
 122     if (any(lcobound  (A) /= [n+2,n-1])) STOP 53
 123     if (any(ucobound  (A) /= [n+5,n-1])) STOP 54
 124   end subroutine three_b
 125
 126   subroutine four(A)
 127     integer, allocatable :: A(:)[:]
 128     if (this_image(A,dim=1) /= -4_8) STOP 55
 129     if (lcobound  (A,dim=1) /= -4_8) STOP 56
 130     if (ucobound  (A,dim=1) /= -4_8) STOP 57
 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) STOP 58
 140     if (this_image(foo,dim=i) /= 5) STOP 59
 141     if (lcobound(foo,dim=i) /= 5) STOP 60
 142     if (ucobound(foo,dim=i) /= 7) STOP 61
 143
 144     i = 2
 145     if (this_image(foo,dim=i) /= 4) STOP 62
 146     if (lcobound(foo,dim=i) /= 4) STOP 63
 147     if (ucobound(foo,dim=i) /= 4) STOP 64
 148   end subroutine five
 149 end program test