libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-1-directive.f90

   1 ! Test OpenACC 'declare create' with allocatable arrays.
   2
   3 ! { dg-do run }
   4
   5 !TODO-OpenACC-declare-allocate
   6 ! Missing support for OpenACC "Changes from Version 2.0 to 2.5":
   7 ! "The 'declare create' directive with a Fortran 'allocatable' has new behavior".
   8 ! Thus, after 'allocate'/before 'deallocate', do
   9 ! '!$acc enter data create'/'!$acc exit data delete' manually.
  10
  11 !TODO { dg-additional-options -fno-inline } for stable results regarding OpenACC 'routine'.
  12
  13 ! { dg-additional-options -fopt-info-all-omp }
  14 ! { dg-additional-options -foffload=-fopt-info-all-omp }
  15
  16 ! { dg-additional-options --param=openacc-privatization=noisy }
  17 ! { dg-additional-options -foffload=--param=openacc-privatization=noisy }
  18 ! Prune a few: uninteresting, and potentially varying depending on GCC configuration (data types):
  19 ! { dg-prune-output {note: variable '[Di]\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} }
  20
  21 ! { dg-additional-options -Wopenacc-parallelism }
  22
  23 ! It's only with Tcl 8.5 (released in 2007) that "the variable 'varName'
  24 ! passed to 'incr' may be unset, and in that case, it will be set to [...]",
  25 ! so to maintain compatibility with earlier Tcl releases, we manually
  26 ! initialize counter variables:
  27 ! { dg-line l_dummy[variable c 0] }
  28 ! { dg-message dummy {} { target iN-VAl-Id } l_dummy } to avoid
  29 ! "WARNING: dg-line var l_dummy defined, but not used".
  30
  31
  32 module vars
  33   implicit none
  34   integer, parameter :: n = 100
  35   real*8, allocatable :: b(:)
  36  !$acc declare create (b)
  37 end module vars
  38
  39 program test
  40   use vars
  41   use openacc
  42   implicit none
  43   real*8 :: a
  44   integer :: i
  45
  46   interface
  47      subroutine sub1
  48        !$acc routine gang
  49      end subroutine sub1
  50
  51      subroutine sub2
  52      end subroutine sub2
  53
  54      real*8 function fun1 (ix)
  55        integer ix
  56        !$acc routine seq
  57      end function fun1
  58
  59      real*8 function fun2 (ix)
  60        integer ix
  61        !$acc routine seq
  62      end function fun2
  63   end interface
  64
  65   if (allocated (b)) error stop
  66
  67   ! Test local usage of an allocated declared array.
  68
  69   allocate (b(n))
  70   !$acc enter data create (b)
  71
  72   if (.not.allocated (b)) error stop
  73   if (.not.acc_is_present (b)) error stop
  74
  75   a = 2.0
  76
  77   !$acc parallel loop ! { dg-line l[incr c] }
  78   ! { dg-note {variable 'i' in 'private' clause is candidate for adjusting OpenACC privatization level} {} { target *-*-* } l$c }
  79   !   { dg-note {variable 'i' ought to be adjusted for OpenACC privatization level: 'vector'} {} { target *-*-* } l$c }
  80   !   { dg-note {variable 'i' adjusted for OpenACC privatization level: 'vector'} {} { target { ! openacc_host_selected } } l$c }
  81   ! { dg-note {variable 'i\.[0-9]+' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} {} { target *-*-* } l$c }
  82   ! { dg-optimized {assigned OpenACC gang vector loop parallelism} {} { target *-*-* } l$c }
  83   do i = 1, n
  84      b(i) = i * a
  85   end do
  86
  87   if (.not.acc_is_present (b)) error stop
  88
  89   !$acc update host(b)
  90
  91   do i = 1, n
  92      if (b(i) /= i*a) error stop
  93   end do
  94
  95   !$acc exit data delete (b)
  96   deallocate (b)
  97
  98   ! Test the usage of an allocated declared array inside an acc
  99   ! routine subroutine.
 100
 101   allocate (b(n))
 102   !$acc enter data create (b)
 103
 104   if (.not.allocated (b)) error stop
 105   if (.not.acc_is_present (b)) error stop
 106
 107   !$acc parallel
 108   call sub1 ! { dg-line l[incr c] }
 109   ! { dg-optimized {assigned OpenACC gang worker vector loop parallelism} {} { target *-*-* } l$c }
 110   !$acc end parallel
 111
 112   if (.not.acc_is_present (b)) error stop
 113
 114   !$acc update host(b)
 115
 116   do i = 1, n
 117      if (b(i) /= i*2) error stop
 118   end do
 119
 120   !$acc exit data delete (b)
 121   deallocate (b)
 122
 123   ! Test the usage of an allocated declared array inside a host
 124   ! subroutine.
 125
 126   call sub2
 127
 128   if (.not.acc_is_present (b)) error stop
 129
 130   !$acc update host(b)
 131
 132   do i = 1, n
 133      if (b(i) /= 1.0) error stop
 134   end do
 135
 136   !$acc exit data delete (b)
 137   deallocate (b)
 138
 139   if (allocated (b)) error stop
 140
 141   ! Test the usage of an allocated declared array inside an acc
 142   ! routine function.
 143
 144   allocate (b(n))
 145   !$acc enter data create (b)
 146
 147   if (.not.allocated (b)) error stop
 148   if (.not.acc_is_present (b)) error stop
 149
 150   !$acc parallel loop ! { dg-line l[incr c] }
 151   ! { dg-note {variable 'i' in 'private' clause is candidate for adjusting OpenACC privatization level} {} { target *-*-* } l$c }
 152   !   { dg-note {variable 'i' ought to be adjusted for OpenACC privatization level: 'vector'} {} { target *-*-* } l$c }
 153   !   { dg-note {variable 'i' adjusted for OpenACC privatization level: 'vector'} {} { target { ! openacc_host_selected } } l$c }
 154   ! { dg-note {variable 'i\.[0-9]+' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} {} { target *-*-* } l$c }
 155   ! { dg-optimized {assigned OpenACC gang vector loop parallelism} {} { target *-*-* } l$c }
 156   do i = 1, n
 157      b(i) = 1.0
 158   end do
 159
 160   !$acc parallel loop ! { dg-line l[incr c] }
 161   ! { dg-note {variable 'i' in 'private' clause is candidate for adjusting OpenACC privatization level} {} { target *-*-* } l$c }
 162   !   { dg-note {variable 'i' ought to be adjusted for OpenACC privatization level: 'vector'} {} { target *-*-* } l$c }
 163   !   { dg-note {variable 'i' adjusted for OpenACC privatization level: 'vector'} {} { target { ! openacc_host_selected } } l$c }
 164   ! { dg-note {variable 'i\.[0-9]+' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} {} { target *-*-* } l$c }
 165   ! { dg-optimized {assigned OpenACC gang vector loop parallelism} {} { target *-*-* } l$c }
 166   do i = 1, n
 167      b(i) = fun1 (i) ! { dg-line l[incr c] }
 168      ! { dg-optimized {assigned OpenACC seq loop parallelism} {} { target *-*-* } l$c }
 169   end do
 170
 171   if (.not.acc_is_present (b)) error stop
 172
 173   !$acc update host(b)
 174
 175   do i = 1, n
 176      if (b(i) /= i) error stop
 177   end do
 178
 179   !$acc exit data delete (b)
 180   deallocate (b)
 181
 182   ! Test the usage of an allocated declared array inside a host
 183   ! function.
 184
 185   allocate (b(n))
 186   !$acc enter data create (b)
 187
 188   if (.not.allocated (b)) error stop
 189   if (.not.acc_is_present (b)) error stop
 190
 191   !$acc parallel loop ! { dg-line l[incr c] }
 192   ! { dg-note {variable 'i' in 'private' clause is candidate for adjusting OpenACC privatization level} {} { target *-*-* } l$c }
 193   !   { dg-note {variable 'i' ought to be adjusted for OpenACC privatization level: 'vector'} {} { target *-*-* } l$c }
 194   !   { dg-note {variable 'i' adjusted for OpenACC privatization level: 'vector'} {} { target { ! openacc_host_selected } } l$c }
 195   ! { dg-note {variable 'i\.[0-9]+' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} {} { target *-*-* } l$c }
 196   ! { dg-optimized {assigned OpenACC gang vector loop parallelism} {} { target *-*-* } l$c }
 197   do i = 1, n
 198      b(i) = 1.0
 199   end do
 200
 201   !$acc update host(b)
 202
 203   do i = 1, n
 204      b(i) = fun2 (i)
 205   end do
 206
 207   if (.not.acc_is_present (b)) error stop
 208
 209   do i = 1, n
 210      if (b(i) /= i*i) error stop
 211   end do
 212
 213   !$acc exit data delete (b)
 214   deallocate (b)
 215 end program test ! { dg-line l[incr c] }
 216 ! { dg-bogus {note: variable 'overflow\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} {TODO n/a} { xfail *-*-* } l$c }
 217 ! { dg-bogus {note: variable 'not_prev_allocated\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} {TODO n/a} { xfail *-*-* } l$c }
 218 ! { dg-bogus {note: variable 'parm\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: artificial} {TODO n/a} { xfail *-*-* } l$c }
 219
 220 ! Set each element in array 'b' at index i to i*2.
 221
 222 subroutine sub1 ! { dg-line subroutine_sub1 }
 223   use vars
 224   implicit none
 225   integer i
 226   !$acc routine gang
 227   ! { dg-bogus {[Ww]arning: region is worker partitioned but does not contain worker partitioned code} {TODO default 'gang' 'vector'} { xfail *-*-* } subroutine_sub1 }
 228
 229   !$acc loop ! { dg-line l[incr c] }
 230   ! { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} {} { target *-*-* } l$c }
 231   ! { dg-optimized {assigned OpenACC gang vector loop parallelism} {} { target *-*-* } l$c }
 232   do i = 1, n
 233      b(i) = i*2
 234   end do
 235 end subroutine sub1
 236
 237 ! Allocate array 'b', and set it to all 1.0.
 238
 239 subroutine sub2
 240   use vars
 241   use openacc
 242   implicit none
 243   integer i
 244
 245   allocate (b(n))
 246   !$acc enter data create (b)
 247
 248   if (.not.allocated (b)) error stop
 249   if (.not.acc_is_present (b)) error stop
 250
 251   !$acc parallel loop ! { dg-line l[incr c] }
 252   ! { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} {} { target *-*-* } l$c }
 253   ! { dg-optimized {assigned OpenACC gang vector loop parallelism} {} { target *-*-* } l$c }
 254   do i = 1, n
 255      b(i) = 1.0
 256   end do
 257 end subroutine sub2
 258
 259 ! Return b(i) * i;
 260
 261 real*8 function fun1 (i)
 262   use vars
 263   implicit none
 264   integer i
 265   !$acc routine seq
 266
 267   fun1 = b(i) * i
 268 end function fun1
 269
 270 ! Return b(i) * i * i;
 271
 272 real*8 function fun2 (i)
 273   use vars
 274   implicit none
 275   integer i
 276
 277   fun2 = b(i) * i * i
 278 end function fun2