libgomp/testsuite/libgomp.oacc-fortran/routine-nohost-1.f90

   1 ! Test 'nohost' clause via 'acc_on_device'.
   2
   3 ! { dg-do run }
   4
   5 ! With optimizations disabled, we currently don't expect that 'acc_on_device' "evaluates at compile time to a constant".
   6 ! { dg-skip-if "TODO PR82391" { *-*-* } { "-O0" } }
   7
   8 ! { dg-additional-options "-fdump-tree-oaccloops" }
   9
  10 program main
  11   use openacc
  12   implicit none
  13   integer, parameter :: n = 10
  14   integer :: a(n), i
  15   integer, external :: fact_nohost
  16   !$acc routine (fact_nohost)
  17   integer, external :: fact
  18
  19   !$acc parallel loop
  20   do i = 1, n
  21      if (acc_on_device(acc_device_not_host)) then
  22         a(i) = fact_nohost(i)
  23      else
  24         a(i) = 0
  25      end if
  26   end do
  27   !$acc end parallel loop
  28
  29   do i = 1, n
  30      if (acc_get_device_type() .eq. acc_device_host) then
  31         if (a(i) .ne. 0) stop 10 + i
  32      else
  33         if (a(i) .ne. fact(i)) stop 20 + i
  34      end if
  35   end do
  36 end program main
  37
  38 recursive function fact(x) result(res)
  39   implicit none
  40   !$acc routine (fact)
  41   integer, intent(in) :: x
  42   integer :: res
  43
  44   if (x < 1) then
  45      res = 1
  46   else
  47      res = x * fact(x - 1)
  48   end if
  49 end function fact
  50
  51 function fact_nohost(x) result(res)
  52   use openacc
  53   implicit none
  54   !$acc routine (fact_nohost) nohost
  55   integer, intent(in) :: x
  56   integer :: res
  57   integer, external :: fact
  58
  59   res = fact(x)
  60 end function fact_nohost
  61 ! { dg-final { scan-tree-dump-times {(?n)^OpenACC routine 'fact_nohost' has 'nohost' clause\.$} 1 oaccloops { target { ! offloading_enabled } } } }
  62 ! { dg-final { scan-tree-dump-times {(?n)^OpenACC routine 'fact_nohost_' has 'nohost' clause\.$} 1 oaccloops { target offloading_enabled } } }
  63 !TODO See PR101551 for 'offloading_enabled' differences.