libgomp/testsuite/libgomp.oacc-fortran/optional-private.f90

   1 ! Test that optional arguments work in private clauses.  The effect of
   2 ! non-present arguments in private clauses is undefined, and is not tested
   3 ! for.  The tests are based on those in private-variables.f90.
   4
   5 ! { dg-do run }
   6
   7 ! { dg-additional-options "-fopt-info-note-omp" }
   8 ! { dg-additional-options "--param=openacc-privatization=noisy" }
   9 ! { dg-additional-options "-foffload=-fopt-info-note-omp" }
  10 ! { dg-additional-options "-foffload=--param=openacc-privatization=noisy" }
  11 ! for testing/documenting aspects of that functionality.
  12
  13 ! { dg-additional-options "-Wopenacc-parallelism" } for testing/documenting
  14 ! aspects of that functionality.
  15
  16
  17 program main
  18   implicit none
  19
  20   type vec3
  21      integer x, y, z, attr(13)
  22   end type vec3
  23   integer :: x
  24   type(vec3) :: pt
  25   integer :: arr(2)
  26
  27   call t1(x)
  28   call t2(pt)
  29   call t3(arr)
  30 contains
  31
  32   ! Test of gang-private variables declared on loop directive.
  33
  34   subroutine t1(x)
  35     integer, optional :: x
  36     integer :: i, arr(32)
  37
  38     do i = 1, 32
  39        arr(i) = i
  40     end do
  41
  42     !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
  43     ! { dg-warning "region is worker partitioned but does not contain worker partitioned code" "" { target *-*-* } .-1 }
  44     ! { dg-warning "region is vector partitioned but does not contain vector partitioned code" "" { target *-*-* } .-2 }
  45     !$acc loop gang private(x)
  46     ! { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
  47     ! { dg-note {variable 'x' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-2 }
  48     do i = 1, 32
  49        x = i * 2;
  50        arr(i) = arr(i) + x
  51     end do
  52     !$acc end parallel
  53
  54     do i = 1, 32
  55        if (arr(i) .ne. i * 3) STOP 1
  56     end do
  57   end subroutine t1
  58
  59
  60   ! Test of gang-private addressable variable declared on loop directive, with
  61   ! broadcasting to partitioned workers.
  62
  63   subroutine t2(pt)
  64     integer i, j, arr(0:32*32)
  65     type(vec3), optional :: pt
  66
  67     do i = 0, 32*32-1
  68        arr(i) = i
  69     end do
  70
  71     !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
  72     ! { dg-warning "region is worker partitioned but does not contain worker partitioned code" "" { target *-*-* } .-1 }
  73     !$acc loop gang private(pt)
  74     ! { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
  75     ! { dg-note {variable 'pt' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-2 }
  76     do i = 0, 31
  77        pt%x = i
  78        pt%y = i * 2
  79        pt%z = i * 4
  80        pt%attr(5) = i * 6
  81
  82        !$acc loop vector
  83        ! { dg-note {variable 'j' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
  84        do j = 0, 31
  85           arr(i * 32 + j) = arr(i * 32 + j) + pt%x + pt%y + pt%z + pt%attr(5);
  86        end do
  87     end do
  88     !$acc end parallel
  89
  90     do i = 0, 32 * 32 - 1
  91        if (arr(i) .ne. i + (i / 32) * 13) STOP 2
  92     end do
  93   end subroutine t2
  94
  95   ! Test of vector-private variables declared on loop directive. Array type.
  96
  97   subroutine t3(pt)
  98     integer, optional :: pt(2)
  99     integer :: i, j, k, idx, arr(0:32*32*32)
 100
 101     do i = 0, 32*32*32-1
 102        arr(i) = i
 103     end do
 104
 105     !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32)
 106     !$acc loop gang
 107     ! { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
 108     do i = 0, 31
 109        !$acc loop worker
 110        ! { dg-note {variable 'j' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
 111        do j = 0, 31
 112           !$acc loop vector private(pt)
 113           ! { dg-note {variable 'k' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
 114           ! { dg-note {variable 'pt' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-2 }
 115           do k = 0, 31
 116              pt(1) = ieor(i, j * 3)
 117              pt(2) = ior(i, j * 5)
 118              arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + pt(1) * k
 119              arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + pt(2) * k
 120           end do
 121        end do
 122     end do
 123     !$acc end parallel
 124
 125     do i = 0, 32 - 1
 126        do j = 0, 32 -1
 127           do k = 0, 32 - 1
 128              idx = i * 1024 + j * 32 + k
 129              if (arr(idx) .ne. idx + ieor(i, j * 3) * k + ior(i, j * 5) * k) then
 130                 STOP 3
 131              end if
 132           end do
 133        end do
 134     end do
 135   end subroutine t3
 136
 137 end program main