libgomp/testsuite/libgomp.fortran/metadirective-6.f90

   1 ! { dg-do compile }
   2
   3 program test
   4   implicit none
   5
   6   integer, parameter :: N = 100
   7   integer :: x(N), y(N), z(N)
   8   integer :: i
   9
  10 contains
  11   subroutine f (x, y, z)
  12     integer :: x(N), y(N), z(N)
  13
  14     !$omp target map (to: x, y) map(from: z)  ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" }
  15       block
  16       !$omp metadirective &
  17                 !$omp& when(device={arch("nvptx")}: teams loop) &
  18                 !$omp& default(parallel loop)  ! { dg-error "\\(1\\)" }
  19  ! FIXME: The line above should be the same error as above but some fails here with -fno-diagnostics-show-caret
  20  ! Seems as if some gcc/testsuite/ fix is missing for libgomp/testsuite
  21         do i = 1, N
  22           z(i) = x(i) * y(i)
  23         enddo
  24        z(N) = z(N) + 1  ! <<< invalid
  25       end block
  26   end subroutine
  27
  28   subroutine f2 (x, y, z)
  29     integer :: x(N), y(N), z(N)
  30
  31     !$omp target map (to: x, y) map(from: z)  ! { dg-error "OMP TARGET region at .1. with a nested TEAMS may not contain any other statement, declaration or directive outside of the single TEAMS construct" }
  32       block
  33       integer :: i ! << invalid
  34       !$omp metadirective &
  35                 !$omp& when(device={arch("nvptx")}: teams loop) &
  36                 !$omp& default(parallel loop)
  37         do i = 1, N
  38           z(i) = x(i) * y(i)
  39         enddo
  40       end block
  41   end subroutine
  42   subroutine g (x, y, z)
  43     integer :: x(N), y(N), z(N)
  44
  45     !$omp target map (to: x, y) map(from: z)  ! { dg-error "OMP TARGET region at .1. with a nested TEAMS may not contain any other statement, declaration or directive outside of the single TEAMS construct" }
  46     block
  47       !$omp metadirective &   ! <<<< invalid
  48                 !$omp& when(device={arch("nvptx")}: flush) &
  49                 !$omp& default(nothing)
  50        !$omp teams loop
  51         do i = 1, N
  52           z(i) = x(i) * y(i)
  53         enddo
  54     end block
  55     !$omp end target
  56   end subroutine
  57
  58 end program