1! 'atomic' access of vector-private variable
2
3! { dg-do run }
4
5! { dg-additional-options "-fopt-info-note-omp" }
6! { dg-additional-options "--param=openacc-privatization=noisy" }
7! { dg-additional-options "-foffload=-fopt-info-note-omp" }
8! { dg-additional-options "-foffload=--param=openacc-privatization=noisy" }
9! for testing/documenting aspects of that functionality.
10
11
12program main
13  integer :: w, arr(0:31)
14
15  !$acc parallel num_gangs(32) num_workers(32) copyout(arr)
16    !$acc loop gang worker vector private(w)
17    ! { dg-note {variable 'j' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
18    ! { dg-note {variable 'w' in 'private' clause is candidate for adjusting OpenACC privatization level} "" { target *-*-* } .-2 }
19    ! { dg-note {variable 'w' ought to be adjusted for OpenACC privatization level: 'vector'} "" { target *-*-* } .-3 }
20    ! { dg-note {variable 'w' adjusted for OpenACC privatization level: 'vector'} "" { target { ! openacc_host_selected } } .-4 }
21    do j = 0, 31
22      w = 0
23      !$acc loop seq
24      ! { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
25      do i = 0, 31
26        !$acc atomic update
27        w = w + 1
28        ! nvptx offloading: PR83812 "operation not supported on global/shared address space".
29        ! { dg-output "(\n|\r\n|\r)libgomp: cuStreamSynchronize error: operation not supported on global/shared address space(\n|\r\n|\r)$" { target openacc_nvidia_accel_selected } }
30        !   Scan for what we expect in the "XFAILed" case (without actually XFAILing).
31        ! { dg-shouldfail "XFAILed" { openacc_nvidia_accel_selected } }
32        !   ... instead of 'dg-xfail-run-if' so that 'dg-output' is evaluated at all.
33        ! { dg-final { if { [dg-process-target { xfail openacc_nvidia_accel_selected }] == "F" } { xfail "[testname-for-summary] really is XFAILed" } } }
34        !   ... so that we still get an XFAIL visible in the log.
35        !$acc end atomic
36      end do
37      arr(j) = w
38    end do
39  !$acc end parallel
40
41  if (any (arr .ne. 32)) stop 1
42end program main
43