xref: /llvm-project/flang/test/Semantics/OpenMP/default-none.f90 (revision eef3766ae5a39fea6f7f81ac444f878969743d85)
1!RUN: %python %S/../test_errors.py %s %flang -fopenmp
2! Positive tests for default(none)
3subroutine sb2(x)
4  real :: x
5end subroutine
6
7subroutine 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
27contains
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
41end subroutine
42
43!construct-name inside default(none)
44subroutine sb4
45  !$omp parallel default(none)
46    loop: do i = 1, 10
47    end do loop
48  !$omp end parallel
49end subroutine
50
51! Test that default(none) does not error for assumed-size array
52subroutine 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
60end subroutine sub
61