gcc/testsuite/gfortran.dg/goacc/routine-6.f90

   1
   2 module m
   3   integer m1int
   4 contains
   5   subroutine subr5 (x)
   6   implicit none
   7   !$acc routine (subr5)
   8   !$acc routine (m1int) ! { dg-error "invalid function name" }
   9   integer, intent(inout) :: x
  10   if (x < 1) then
  11      x = 1
  12   else
  13      x = x * x - 1
  14   end if
  15   end subroutine subr5
  16 end module m
  17
  18 program main
  19   implicit none
  20   interface
  21     function subr6 (x)
  22     !$acc routine (subr6) ! { dg-error "without list is allowed in interface" }
  23     integer, intent (in) :: x
  24     integer :: subr6
  25     end function subr6
  26   end interface
  27   integer, parameter :: n = 10
  28   integer :: a(n), i
  29   !$acc routine (subr1) ! { dg-error "invalid function name" }
  30   external :: subr2
  31   !$acc routine (subr2)
  32   !$acc parallel
  33   !$acc loop
  34   do i = 1, n
  35      call subr1 (i)
  36      call subr2 (i)
  37   end do
  38   !$acc end parallel
  39 end program main
  40
  41 subroutine subr1 (x)
  42   !$acc routine
  43   integer, intent(inout) :: x
  44   if (x < 1) then
  45      x = 1
  46   else
  47      x = x * x - 1
  48   end if
  49 end subroutine subr1
  50
  51 subroutine subr2 (x)
  52   !$acc routine (subr1) ! { dg-error "invalid function name" }
  53   integer, intent(inout) :: x
  54   if (x < 1) then
  55      x = 1
  56   else
  57      x = x * x - 1
  58   end if
  59 end subroutine subr2
  60
  61 subroutine subr3 (x)
  62   !$acc routine (subr3)
  63   integer, intent(inout) :: x
  64   if (x < 1) then
  65      x = 1
  66   else
  67      call subr4 (x)
  68   end if
  69 end subroutine subr3
  70
  71 subroutine subr4 (x)
  72   !$acc routine (subr4)
  73   integer, intent(inout) :: x
  74   if (x < 1) then
  75      x = 1
  76   else
  77      x = x * x - 1
  78   end if
  79 end subroutine subr4
  80
  81 subroutine subr10 (x)
  82   !$acc routine (subr10) device ! { dg-error "Unclassifiable OpenACC directive" }
  83   integer, intent(inout) :: x
  84   if (x < 1) then
  85      x = 1
  86   else
  87      x = x * x - 1
  88   end if
  89 end subroutine subr10