Projet_SETI_RISC-V/riscv-gnu-toolchain/gcc/libgomp/testsuite/libgomp.oacc-fortran/parallel-dims.f90
2023-03-06 14:48:14 +01:00

149 lines
6 KiB
Fortran

! OpenACC parallelism dimensions clauses: num_gangs, num_workers,
! vector_length.
! { dg-additional-sources parallel-dims-aux.c }
! { dg-do run }
! { dg-prune-output "command-line option '-fintrinsic-modules-path=.*' is valid for Fortran but not for C" }
! { dg-additional-options "-DEXPENSIVE" { target run_expensive_tests } }
! { dg-additional-options "-cpp" }
! { dg-additional-options "-fopt-info-note-omp" }
! { dg-additional-options "--param=openacc-privatization=noisy" }
! { dg-additional-options "-foffload=-fopt-info-note-omp" }
! { dg-additional-options "-foffload=--param=openacc-privatization=noisy" }
! for testing/documenting aspects of that functionality.
! { dg-additional-options "-Wopenacc-parallelism" } for testing/documenting
! aspects of that functionality.
! See also '../libgomp.oacc-c-c++-common/parallel-dims.c'.
module acc_routines
implicit none (type, external)
interface
integer function acc_gang() bind(C)
!$acc routine seq
end function acc_gang
integer function acc_worker() bind(C)
!$acc routine seq
end function acc_worker
integer function acc_vector() bind(C)
!$acc routine seq
end function acc_vector
end interface
end module acc_routines
program main
use iso_c_binding
use openacc
use acc_routines
implicit none (type, external)
integer :: gangs_min, gangs_max, workers_min, workers_max, vectors_min, vectors_max
integer :: vectors_actual
integer :: i, j, k
#ifdef EXPENSIVE
integer, parameter :: N = 100
#else
integer, parameter :: N = 50
#endif
call acc_init (acc_device_default)
! OpenACC parallel construct.
!TODO
! OpenACC kernels construct.
!TODO
! OpenACC serial construct.
! GR, WS, VS.
gangs_min = huge(gangs_min) ! INT_MAX
workers_min = huge(workers_min) ! INT_MAX
vectors_min = huge(vectors_min) ! INT_MAX
gangs_max = -huge(gangs_max) - 1 ! INT_MIN
workers_max = -huge(gangs_max) - 1 ! INT_MIN
vectors_max = -huge(gangs_max) - 1 ! INT_MIN
!$acc serial &
!$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 } }
! { dg-note {variable 'D\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
do i = N, -(N-1), -1
gangs_min = acc_gang ();
gangs_max = acc_gang ();
workers_min = acc_worker ();
workers_max = acc_worker ();
vectors_min = acc_vector ();
vectors_max = acc_vector ();
end do
!$acc end serial
if (gangs_min /= 0 .or. gangs_max /= 1 - 1 &
.or. workers_min /= 0 .or. workers_max /= 1 - 1 &
.or. vectors_min /= 0 .or. vectors_max /= 1 - 1) &
stop 1
! Composition of GP, WP, VP.
vectors_actual = 1 ! Implicit 'vector_length (1)' clause.
gangs_min = huge(gangs_min) ! INT_MAX
workers_min = huge(workers_min) ! INT_MAX
vectors_min = huge(vectors_min) ! INT_MAX
gangs_max = -huge(gangs_max) - 1 ! INT_MIN
workers_max = -huge(gangs_max) - 1 ! INT_MIN
vectors_max = -huge(gangs_max) - 1 ! INT_MIN
!$acc serial copy (vectors_actual) &
!$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 } }
! { dg-bogus "\[Ww\]arning: region contains gang partitioned code but is not gang partitioned" "TODO 'serial'" { xfail *-*-* } .-1 }
! { dg-bogus "\[Ww\]arning: region contains worker partitioned code but is not worker partitioned" "TODO 'serial'" { xfail *-*-* } .-2 }
! { dg-bogus "\[Ww\]arning: region contains vector partitioned code but is not vector partitioned" "TODO 'serial'" { xfail *-*-* } .-3 }
! { dg-note {variable 'C.[0-9]+' declared in block potentially has improper OpenACC privatization level: 'const_decl'} "TODO" { target *-*-* } .-4 }
!TODO Unhandled 'CONST_DECL' instance for constant argument in 'acc_on_device' call.
if (acc_on_device (acc_device_nvidia)) then
! The GCC nvptx back end enforces vector_length (32).
! It's unclear if that's actually permissible here;
! <https://github.com/OpenACC/openacc-spec/issues/238> "OpenACC 'serial'
! construct might not actually be serial".
vectors_actual = 32
end if
!$acc loop gang reduction (min: gangs_min, workers_min, vectors_min) reduction (max: gangs_max, workers_max, vectors_max)
! { dg-note {variable 'i' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
do i = N, -(N-1), -1
!$acc loop worker reduction (min: gangs_min, workers_min, vectors_min) reduction (max: gangs_max, workers_max, vectors_max)
! { dg-note {variable 'j' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
! { dg-note {variable 'D\.[0-9]+' declared in block isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-2 }
do j = N, -(N-1), -1
!$acc loop vector reduction (min: gangs_min, workers_min, vectors_min) reduction (max: gangs_max, workers_max, vectors_max)
! { dg-note {variable 'k' in 'private' clause isn't candidate for adjusting OpenACC privatization level: not addressable} "" { target *-*-* } .-1 }
do k = N * vectors_actual, -(N-1) * vectors_actual, -1
gangs_min = acc_gang ();
gangs_max = acc_gang ();
workers_min = acc_worker ();
workers_max = acc_worker ();
vectors_min = acc_vector ();
vectors_max = acc_vector ();
end do
end do
end do
!$acc end serial
if (acc_get_device_type () .eq. acc_device_nvidia) then
if (vectors_actual /= 32) stop 2
else
if (vectors_actual /= 1) stop 3
end if
if (gangs_min /= 0 .or. gangs_max /= 1 - 1 &
.or. workers_min /= 0 .or. workers_max /= 1 - 1 &
.or. vectors_min /= 0 .or. vectors_max /= vectors_actual - 1) &
stop 4
end program main