brintos

brintos / llvm-project-archived public Read only

0
0
Text · 1.6 KiB · a56657c Raw
76 lines · plain
1!RUN: %python %S/../test_errors.py %s %flang -fopenmp2! Positive tests for default(none)3subroutine sb2(x)4  real :: x5end subroutine6 7subroutine sb18  integer :: i9  real :: a(10), b(10), k10  inc(x) = x + 1.011  abstract interface12    function iface(a, b)13      real, intent(in) :: a, b14      real :: iface15    end function16  end interface17  procedure(iface) :: compute18  procedure(iface), pointer :: ptr => NULL()19  ptr => fn220  !$omp parallel default(none) shared(a,b,k) private(i)21  do i = 1, 1022    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 do26  !$omp end parallel27contains28 function fn1(x)29   real :: x, fn130   fn1 = x31 end function32 function fn2(x, y)33   real, intent(in) :: x, y34   real :: fn235   fn2 = x + y36 end function37 subroutine sb3(x)38   real :: x39   print *, x40 end subroutine41end subroutine42 43!construct-name inside default(none)44subroutine sb445  !$omp parallel default(none)46    loop: do i = 1, 1047    end do loop48  !$omp end parallel49end subroutine50 51! Test that default(none) does not error for assumed-size array52subroutine sub( aaa)53  real,dimension(*),intent(in)::aaa54  integer::ip55  real::ccc56!$omp parallel do private(ip,ccc) default(none)57  do ip = 1, 1058     ccc= aaa(ip)59  end do60end subroutine sub61 62! Test that threadprivate variables with host association63! have a predetermined DSA64subroutine host_assoc()65  integer, save :: i66  !$omp threadprivate(i)67  real, save :: r68  !$omp threadprivate(r)69contains70  subroutine internal()71!$omp parallel default(none)72    print *, i, r73!$omp end parallel74  end subroutine internal75end subroutine host_assoc76