0829ab79d3
This really is a separate step -- and another pass to be added between the two, later on. gcc/ * omp-offload.c (oacc_loop_xform_head_tail, oacc_loop_process): 'update_stmt' after modification. (pass_oacc_loop_designation): New function, extracted out of... (pass_oacc_device_lower): ... this. (pass_data_oacc_loop_designation, pass_oacc_loop_designation) (make_pass_oacc_loop_designation): New * passes.def: Add it. * tree-parloops.c (create_parallel_loop): Adjust. * tree-pass.h (make_pass_oacc_loop_designation): New. gcc/testsuite/ * c-c++-common/goacc/classify-kernels-unparallelized.c: 's%oaccdevlow%oaccloops%g'. * c-c++-common/goacc/classify-kernels.c: Likewise. * c-c++-common/goacc/classify-parallel.c: Likewise. * c-c++-common/goacc/classify-routine-nohost.c: Likewise. * c-c++-common/goacc/classify-routine.c: Likewise. * c-c++-common/goacc/classify-serial.c: Likewise. * c-c++-common/goacc/routine-nohost-1.c: Likewise. * g++.dg/goacc/template.C: Likewise. * gcc.dg/goacc/loop-processing-1.c: Likewise. * gfortran.dg/goacc/classify-kernels-unparallelized.f95: Likewise. * gfortran.dg/goacc/classify-kernels.f95: Likewise. * gfortran.dg/goacc/classify-parallel.f95: Likewise. * gfortran.dg/goacc/classify-routine-nohost.f95: Likewise. * gfortran.dg/goacc/classify-routine.f95: Likewise. * gfortran.dg/goacc/classify-serial.f95: Likewise. * gfortran.dg/goacc/routine-multiple-directives-1.f90: Likewise. libgomp/ * testsuite/libgomp.oacc-c-c++-common/pr85486-2.c: 's%oaccdevlow%oaccloops%g'. * testsuite/libgomp.oacc-c-c++-common/pr85486-3.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/pr85486.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/routine-nohost-1.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/vector-length-128-1.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/vector-length-128-2.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/vector-length-128-3.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/vector-length-128-4.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/vector-length-128-5.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/vector-length-128-6.c: Likewise. * testsuite/libgomp.oacc-c-c++-common/vector-length-128-7.c: Likewise. * testsuite/libgomp.oacc-fortran/routine-nohost-1.f90: Likewise. Co-Authored-By: Julian Brown <julian@codesourcery.com> Co-Authored-By: Kwok Cheung Yeung <kcy@codesourcery.com>
64 lines
1.6 KiB
Fortran
64 lines
1.6 KiB
Fortran
! Test 'nohost' clause via 'acc_on_device'.
|
|
|
|
! { dg-do run }
|
|
|
|
! With optimizations disabled, we currently don't expect that 'acc_on_device' "evaluates at compile time to a constant".
|
|
! { dg-skip-if "TODO PR82391" { *-*-* } { "-O0" } }
|
|
|
|
! { dg-additional-options "-fdump-tree-oaccloops" }
|
|
|
|
program main
|
|
use openacc
|
|
implicit none
|
|
integer, parameter :: n = 10
|
|
integer :: a(n), i
|
|
integer, external :: fact_nohost
|
|
!$acc routine (fact_nohost)
|
|
integer, external :: fact
|
|
|
|
!$acc parallel loop
|
|
do i = 1, n
|
|
if (acc_on_device(acc_device_not_host)) then
|
|
a(i) = fact_nohost(i)
|
|
else
|
|
a(i) = 0
|
|
end if
|
|
end do
|
|
!$acc end parallel loop
|
|
|
|
do i = 1, n
|
|
if (acc_get_device_type() .eq. acc_device_host) then
|
|
if (a(i) .ne. 0) stop 10 + i
|
|
else
|
|
if (a(i) .ne. fact(i)) stop 20 + i
|
|
end if
|
|
end do
|
|
end program main
|
|
|
|
recursive function fact(x) result(res)
|
|
implicit none
|
|
!$acc routine (fact)
|
|
integer, intent(in) :: x
|
|
integer :: res
|
|
|
|
if (x < 1) then
|
|
res = 1
|
|
else
|
|
res = x * fact(x - 1)
|
|
end if
|
|
end function fact
|
|
|
|
function fact_nohost(x) result(res)
|
|
use openacc
|
|
implicit none
|
|
!$acc routine (fact_nohost) nohost
|
|
integer, intent(in) :: x
|
|
integer :: res
|
|
integer, external :: fact
|
|
|
|
res = fact(x)
|
|
end function fact_nohost
|
|
! { dg-final { scan-tree-dump-times {(?n)^OpenACC routine 'fact_nohost' has 'nohost' clause\.$} 1 oaccloops { target { ! offloading_enabled } } } }
|
|
! { dg-final { scan-tree-dump-times {(?n)^OpenACC routine 'fact_nohost_' has 'nohost' clause\.$} 1 oaccloops { target offloading_enabled } } }
|
|
!TODO See PR101551 for 'offloading_enabled' differences.
|