1! OpenACC parallelism dimensions clauses: num_gangs, num_workers,
2! vector_length.
3
4! { dg-additional-sources parallel-dims-aux.c }
5! { dg-do run }
6! { dg-prune-output "command-line option '-fintrinsic-modules-path=.*' is valid for Fortran but not for C" }
7
8! { dg-additional-options "-fopt-info-note-omp" }
9! { dg-additional-options "--param=openacc-privatization=noisy" }
10! { dg-additional-options "-foffload=-fopt-info-note-omp" }
11! { dg-additional-options "-foffload=--param=openacc-privatization=noisy" }
12! for testing/documenting aspects of that functionality.
13
14! { dg-additional-options "-Wopenacc-parallelism" } for testing/documenting
15! aspects of that functionality.
16
17! See also '../libgomp.oacc-c-c++-common/parallel-dims.c'.
18
19module acc_routines
20  implicit none (type, external)
21
22  interface
23    integer function acc_gang() bind(C)
24      !$acc routine seq
25    end function acc_gang
26
27    integer function acc_worker() bind(C)
28      !$acc routine seq
29    end function acc_worker
30
31    integer function acc_vector() bind(C)
32      !$acc routine seq
33    end function acc_vector
34  end interface
35end module acc_routines
36
37program main
38  use iso_c_binding
39  use openacc
40  use acc_routines
41  implicit none (type, external)
42
43  integer :: gangs_min, gangs_max, workers_min, workers_max, vectors_min, vectors_max
44  integer :: vectors_actual
45  integer :: i, j, k
46
47  call acc_init (acc_device_default)
48
49  ! OpenACC parallel construct.
50
51  !TODO
52
53
54  ! OpenACC kernels construct.
55
56  !TODO
57
58
59  ! OpenACC serial construct.
60
61  ! GR, WS, VS.
62
63  gangs_min = huge(gangs_min) ! INT_MAX
64  workers_min = huge(workers_min) ! INT_MAX
65  vectors_min = huge(vectors_min) ! INT_MAX
66  gangs_max = -huge(gangs_max) - 1  ! INT_MIN
67  workers_max = -huge(gangs_max) - 1 ! INT_MIN
68  vectors_max = -huge(gangs_max) - 1 ! INT_MIN
69  !$acc serial &
70  !$acc   reduction (min: gangs_min, workers_min, vectors_min) reduction (max: gangs_max, workers_max, vectors_max) ! { dg-warning "using vector_length \\(32\\), ignoring 1" "" { target openacc_nvidia_accel_selected } }
71  ! { dg-note {variable 'D\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
72  do i = 100, -99, -1
73     gangs_min = acc_gang ();
74     gangs_max = acc_gang ();
75     workers_min = acc_worker ();
76     workers_max = acc_worker ();
77     vectors_min = acc_vector ();
78     vectors_max = acc_vector ();
79  end do
80  !$acc end serial
81  if (gangs_min /= 0 .or. gangs_max /= 1 - 1 &
82      .or. workers_min /= 0 .or. workers_max /= 1 - 1 &
83      .or. vectors_min /= 0 .or. vectors_max /= 1 - 1) &
84    stop 1
85
86  ! Composition of GP, WP, VP.
87
88  vectors_actual = 1 ! Implicit 'vector_length (1)' clause.
89  gangs_min = huge(gangs_min) ! INT_MAX
90  workers_min = huge(workers_min) ! INT_MAX
91  vectors_min = huge(vectors_min) ! INT_MAX
92  gangs_max = -huge(gangs_max) - 1  ! INT_MIN
93  workers_max = -huge(gangs_max) - 1 ! INT_MIN
94  vectors_max = -huge(gangs_max) - 1 ! INT_MIN
95  !$acc serial copy (vectors_actual) &
96  !$acc   copy (gangs_min, gangs_max, workers_min, workers_max, vectors_min, vectors_max) ! { dg-warning "using vector_length \\(32\\), ignoring 1" "" { target openacc_nvidia_accel_selected } }
97  ! { dg-bogus "\[Ww\]arning: region contains gang partitioned code but is not gang partitioned" "TODO 'serial'" { xfail *-*-* } .-1 }
98  ! { dg-bogus "\[Ww\]arning: region contains worker partitioned code but is not worker partitioned" "TODO 'serial'" { xfail *-*-* } .-2 }
99  ! { dg-bogus "\[Ww\]arning: region contains vector partitioned code but is not vector partitioned" "TODO 'serial'" { xfail *-*-* } .-3 }
100  ! { dg-note {variable 'C.[0-9]+' declared in block potentially has improper OpenACC privatization level: 'const_decl'} "TODO" { target *-*-* } .-4 }
101  !TODO Unhandled 'CONST_DECL' instance for constant argument in 'acc_on_device' call.
102  if (acc_on_device (acc_device_nvidia)) then
103     ! The GCC nvptx back end enforces vector_length (32).
104     ! It's unclear if that's actually permissible here;
105     ! <https://github.com/OpenACC/openacc-spec/issues/238> "OpenACC 'serial'
106     ! construct might not actually be serial".
107   vectors_actual = 32
108  end if
109  !$acc loop gang reduction (min: gangs_min, workers_min, vectors_min) reduction (max: gangs_max, workers_max, vectors_max)
110  ! { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
111  do i = 100, -99, -1
112     !$acc loop worker reduction (min: gangs_min, workers_min, vectors_min) reduction (max: gangs_max, workers_max, vectors_max)
113     ! { dg-note {variable 'j' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
114     ! { dg-note {variable 'D\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-2 }
115     do j = 100, -99, -1
116        !$acc loop vector reduction (min: gangs_min, workers_min, vectors_min) reduction (max: gangs_max, workers_max, vectors_max)
117        ! { dg-note {variable 'k' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
118        do k = 100 * vectors_actual, -99 * vectors_actual, -1
119           gangs_min = acc_gang ();
120           gangs_max = acc_gang ();
121           workers_min = acc_worker ();
122           workers_max = acc_worker ();
123           vectors_min = acc_vector ();
124           vectors_max = acc_vector ();
125        end do
126     end do
127  end do
128  !$acc end serial
129  if (acc_get_device_type () .eq. acc_device_nvidia) then
130     if (vectors_actual /= 32) stop 2
131  else
132     if (vectors_actual /= 1) stop 3
133  end if
134  if (gangs_min /= 0 .or. gangs_max /= 1 - 1 &
135      .or. workers_min /= 0 .or. workers_max /= 1 - 1 &
136      .or. vectors_min /= 0 .or. vectors_max /= vectors_actual - 1) &
137    stop 4
138
139end program main
140