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

   1 ! Test OpenACC 'declare create' with allocatable arrays.
   2
   3 ! { dg-do run }
   4
   5 !TODO-OpenACC-declare-allocate
   6 ! Not currently implementing correct '-DACC_MEM_SHARED=0' behavior:
   7 ! Missing support for OpenACC "Changes from Version 2.0 to 2.5":
   8 ! "The 'declare create' directive with a Fortran 'allocatable' has new behavior".
   9 ! { dg-xfail-run-if TODO { *-*-* } { -DACC_MEM_SHARED=0 } }
  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
  71   if (.not.allocated (b)) error stop
  72   if (.not.acc_is_present (b)) error stop
  73
  74   a = 2.0
  75
  76   !$acc parallel loop ! { dg-line l[incr c] }
  77   ! { dg-note {variable 'i' in 'private' clause is candidate for adjusting OpenACC privatization level} {} { target *-*-* } l$c }
  78   !   { dg-note {variable 'i' ought to be adjusted for OpenACC privatization level: 'vector'} {} { target *-*-* } l$c }
  79   !   { dg-note {variable 'i' adjusted for OpenACC privatization level: 'vector'} {} { target { ! openacc_host_selected } } l$c }
  80   ! { dg-note {variable 'i\.[0-9]+' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} {} { target *-*-* } l$c }
  81   ! { dg-optimized {assigned OpenACC gang vector loop parallelism} {} { target *-*-* } l$c }
  82   do i = 1, n
  83      b(i) = i * a
  84   end do
  85
  86   if (.not.acc_is_present (b)) error stop
  87
  88   !$acc update host(b)
  89
  90   do i = 1, n
  91      if (b(i) /= i*a) error stop
  92   end do
  93
  94   deallocate (b)
  95
  96   ! Test the usage of an allocated declared array inside an acc
  97   ! routine subroutine.
  98
  99   allocate (b(n))
 100
 101   if (.not.allocated (b)) error stop
 102   if (.not.acc_is_present (b)) error stop
 103
 104   !$acc parallel
 105   call sub1 ! { dg-line l[incr c] }
 106   ! { dg-optimized {assigned OpenACC gang worker vector loop parallelism} {} { target *-*-* } l$c }
 107   !$acc end parallel
 108
 109   if (.not.acc_is_present (b)) error stop
 110
 111   !$acc update host(b)
 112
 113   do i = 1, n
 114      if (b(i) /= i*2) error stop
 115   end do
 116
 117   deallocate (b)
 118
 119   ! Test the usage of an allocated declared array inside a host
 120   ! subroutine.
 121
 122   call sub2
 123
 124   if (.not.acc_is_present (b)) error stop
 125
 126   !$acc update host(b)
 127
 128   do i = 1, n
 129      if (b(i) /= 1.0) error stop
 130   end do
 131
 132   deallocate (b)
 133
 134   if (allocated (b)) error stop
 135
 136   ! Test the usage of an allocated declared array inside an acc
 137   ! routine function.
 138
 139   allocate (b(n))
 140
 141   if (.not.allocated (b)) error stop
 142   if (.not.acc_is_present (b)) error stop
 143
 144   !$acc parallel loop ! { dg-line l[incr c] }
 145   ! { dg-note {variable 'i' in 'private' clause is candidate for adjusting OpenACC privatization level} {} { target *-*-* } l$c }
 146   !   { dg-note {variable 'i' ought to be adjusted for OpenACC privatization level: 'vector'} {} { target *-*-* } l$c }
 147   !   { dg-note {variable 'i' adjusted for OpenACC privatization level: 'vector'} {} { target { ! openacc_host_selected } } l$c }
 148   ! { dg-note {variable 'i\.[0-9]+' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} {} { target *-*-* } l$c }
 149   ! { dg-optimized {assigned OpenACC gang vector loop parallelism} {} { target *-*-* } l$c }
 150   do i = 1, n
 151      b(i) = 1.0
 152   end do
 153
 154   !$acc parallel loop ! { dg-line l[incr c] }
 155   ! { dg-note {variable 'i' in 'private' clause is candidate for adjusting OpenACC privatization level} {} { target *-*-* } l$c }
 156   !   { dg-note {variable 'i' ought to be adjusted for OpenACC privatization level: 'vector'} {} { target *-*-* } l$c }
 157   !   { dg-note {variable 'i' adjusted for OpenACC privatization level: 'vector'} {} { target { ! openacc_host_selected } } l$c }
 158   ! { dg-note {variable 'i\.[0-9]+' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} {} { target *-*-* } l$c }
 159   ! { dg-optimized {assigned OpenACC gang vector loop parallelism} {} { target *-*-* } l$c }
 160   do i = 1, n
 161      b(i) = fun1 (i) ! { dg-line l[incr c] }
 162      ! { dg-optimized {assigned OpenACC seq loop parallelism} {} { target *-*-* } l$c }
 163   end do
 164
 165   if (.not.acc_is_present (b)) error stop
 166
 167   !$acc update host(b)
 168
 169   do i = 1, n
 170      if (b(i) /= i) error stop
 171   end do
 172
 173   deallocate (b)
 174
 175   ! Test the usage of an allocated declared array inside a host
 176   ! function.
 177
 178   allocate (b(n))
 179
 180   if (.not.allocated (b)) error stop
 181   if (.not.acc_is_present (b)) error stop
 182
 183   !$acc parallel loop ! { dg-line l[incr c] }
 184   ! { dg-note {variable 'i' in 'private' clause is candidate for adjusting OpenACC privatization level} {} { target *-*-* } l$c }
 185   !   { dg-note {variable 'i' ought to be adjusted for OpenACC privatization level: 'vector'} {} { target *-*-* } l$c }
 186   !   { dg-note {variable 'i' adjusted for OpenACC privatization level: 'vector'} {} { target { ! openacc_host_selected } } l$c }
 187   ! { dg-note {variable 'i\.[0-9]+' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} {} { target *-*-* } l$c }
 188   ! { dg-optimized {assigned OpenACC gang vector loop parallelism} {} { target *-*-* } l$c }
 189   do i = 1, n
 190      b(i) = 1.0
 191   end do
 192
 193   !$acc update host(b)
 194
 195   do i = 1, n
 196      b(i) = fun2 (i)
 197   end do
 198
 199   if (.not.acc_is_present (b)) error stop
 200
 201   do i = 1, n
 202      if (b(i) /= i*i) error stop
 203   end do
 204
 205   deallocate (b)
 206 end program test ! { dg-line l[incr c] }
 207 ! { 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 }
 208 ! { 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 }
 209 ! { 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 }
 210
 211 ! Set each element in array 'b' at index i to i*2.
 212
 213 subroutine sub1 ! { dg-line subroutine_sub1 }
 214   use vars
 215   implicit none
 216   integer i
 217   !$acc routine gang
 218   ! { dg-bogus {[Ww]arning: region is worker partitioned but does not contain worker partitioned code} {TODO default 'gang' 'vector'} { xfail *-*-* } subroutine_sub1 }
 219
 220   !$acc loop ! { dg-line l[incr c] }
 221   ! { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} {} { target *-*-* } l$c }
 222   ! { dg-optimized {assigned OpenACC gang vector loop parallelism} {} { target *-*-* } l$c }
 223   do i = 1, n
 224      b(i) = i*2
 225   end do
 226 end subroutine sub1
 227
 228 ! Allocate array 'b', and set it to all 1.0.
 229
 230 subroutine sub2
 231   use vars
 232   use openacc
 233   implicit none
 234   integer i
 235
 236   allocate (b(n))
 237
 238   if (.not.allocated (b)) error stop
 239   if (.not.acc_is_present (b)) error stop
 240
 241   !$acc parallel loop ! { dg-line l[incr c] }
 242   ! { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} {} { target *-*-* } l$c }
 243   ! { dg-optimized {assigned OpenACC gang vector loop parallelism} {} { target *-*-* } l$c }
 244   do i = 1, n
 245      b(i) = 1.0
 246   end do
 247 end subroutine sub2
 248
 249 ! Return b(i) * i;
 250
 251 real*8 function fun1 (i)
 252   use vars
 253   implicit none
 254   integer i
 255   !$acc routine seq
 256
 257   fun1 = b(i) * i
 258 end function fun1
 259
 260 ! Return b(i) * i * i;
 261
 262 real*8 function fun2 (i)
 263   use vars
 264   implicit none
 265   integer i
 266
 267   fun2 = b(i) * i * i
 268 end function fun2