1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
! OpenMP offloading regression test that checks we do not cause a segfault when
! implicitly mapping a not present optional allocatable function argument and
! utilise it in the target region. No results requiring checking other than
! that the program compiles and runs to completion with no error.
! REQUIRES: flang, amdgpu
! RUN: %libomptarget-compile-fortran-run-and-check-generic
module mod
implicit none
contains
subroutine routine(a, b)
implicit none
real(4), allocatable, optional, intent(in) :: a(:)
real(4), intent(out) :: b(:)
integer(4) :: i, ia
if(present(a)) then
ia = 1
write(*,*) "a is present"
else
ia=0
write(*,*) "a is not present"
end if
!$omp target teams distribute parallel do shared(a,b,ia)
do i=1,10
if (ia>0) then
b(i) = b(i) + a(i)
end if
end do
end subroutine routine
end module mod
program main
use mod
implicit none
real(4), allocatable :: a(:)
real(4), allocatable :: b(:)
integer(4) :: i
allocate(b(10))
do i=1,10
b(i)=0
end do
!$omp target data map(from: b)
call routine(b=b)
!$omp end target data
deallocate(b)
print *, "success, no segmentation fault"
end program main
!CHECK: a is not present
!CHECK: success, no segmentation fault
|
