flang/test/Semantics/OpenMP/default-none.f90

   1 !RUN: %python %S/../test_errors.py %s %flang -fopenmp
   2 ! Positive tests for default(none)
   3 subroutine sb2(x)
   4   real :: x
   5 end subroutine
   6
   7 subroutine sb1
   8   integer :: i
   9   real :: a(10), b(10), k
  10   inc(x) = x + 1.0
  11   abstract interface
  12     function iface(a, b)
  13       real, intent(in) :: a, b
  14       real :: iface
  15     end function
  16   end interface
  17   procedure(iface) :: compute
  18   procedure(iface), pointer :: ptr => NULL()
  19   ptr => fn2
  20   !$omp parallel default(none) shared(a,b,k) private(i)
  21   do i = 1, 10
  22     b(i) = k + sin(a(i)) + inc(a(i)) + fn1(a(i)) + compute(a(i),k) + add(k, k)
  23     call sb3(b(i))
  24     call sb2(a(i))
  25   end do
  26   !$omp end parallel
  27 contains
  28  function fn1(x)
  29    real :: x, fn1
  30    fn1 = x
  31  end function
  32  function fn2(x, y)
  33    real, intent(in) :: x, y
  34    real :: fn2
  35    fn2 = x + y
  36  end function
  37  subroutine sb3(x)
  38    real :: x
  39    print *, x
  40  end subroutine
  41 end subroutine
  42
  43 !construct-name inside default(none)
  44 subroutine sb4
  45   !$omp parallel default(none)
  46     loop: do i = 1, 10
  47     end do loop
  48   !$omp end parallel
  49 end subroutine
  50
  51 ! Test that default(none) does not error for assumed-size array
  52 subroutine sub( aaa)
  53   real,dimension(*),intent(in)::aaa
  54   integer::ip
  55   real::ccc
  56 !$omp parallel do private(ip,ccc) default(none)
  57   do ip = 1, 10
  58      ccc= aaa(ip)
  59   end do
  60 end subroutine sub