58 lines · plain
1! OpenMP offloading regression test that checks we do not cause a segfault when2! implicitly mapping a not present optional allocatable function argument and3! utilise it in the target region. No results requiring checking other than4! that the program compiles and runs to completion with no error.5! REQUIRES: flang, amdgpu6 7! RUN: %libomptarget-compile-fortran-run-and-check-generic8module mod9 implicit none10contains11 subroutine routine(a, b)12 implicit none13 real(4), allocatable, optional, intent(in) :: a(:)14 real(4), intent(out) :: b(:)15 integer(4) :: i, ia16 if(present(a)) then17 ia = 118 write(*,*) "a is present"19 else20 ia=021 write(*,*) "a is not present"22 end if23 24 !$omp target teams distribute parallel do shared(a,b,ia)25 do i=1,1026 if (ia>0) then27 b(i) = b(i) + a(i)28 end if29 end do30 31 end subroutine routine32 33end module mod34 35program main36 use mod37 implicit none38 real(4), allocatable :: a(:)39 real(4), allocatable :: b(:)40 integer(4) :: i41 allocate(b(10))42 do i=1,1043 b(i)=044 end do45 !$omp target data map(from: b)46 47 call routine(b=b)48 49 !$omp end target data50 51 deallocate(b)52 53 print *, "success, no segmentation fault"54end program main55 56!CHECK: a is not present57!CHECK: success, no segmentation fault58