diff options
Diffstat (limited to 'libgomp')
-rw-r--r-- | libgomp/ChangeLog | 5 | ||||
-rw-r--r-- | libgomp/libgomp.texi | 2 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/is_device_ptr-2.f90 | 159 |
3 files changed, 165 insertions, 1 deletions
diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog index 97ae4b2..0377b5c 100644 --- a/libgomp/ChangeLog +++ b/libgomp/ChangeLog @@ -1,3 +1,8 @@ +2022-09-30 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/105318 + * testsuite/libgomp.fortran/is_device_ptr-2.f90: New test. + 2022-09-28 Tobias Burnus <tobias@codesourcery.com> * libgomp.texi (OpenMP 5.1): Mark 'assume' as implemented diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi index b5d09fe..03d6913 100644 --- a/libgomp/libgomp.texi +++ b/libgomp/libgomp.texi @@ -345,7 +345,7 @@ The OpenMP 4.5 specification is fully supported. @item Support of structured block sequences in C/C++ @tab Y @tab @item @code{unconstrained} and @code{reproducible} modifiers on @code{order} clause @tab Y @tab -@item Support @code{begin/end declare target} syntax in C/C++ @tab N @tab +@item Support @code{begin/end declare target} syntax in C/C++ @tab Y @tab @item Pointer predetermined firstprivate getting initialized to address of matching mapped list item per 5.1, Sect. 2.21.7.2 @tab N @tab @item For Fortran, diagnose placing declarative before/between @code{USE}, diff --git a/libgomp/testsuite/libgomp.fortran/is_device_ptr-2.f90 b/libgomp/testsuite/libgomp.fortran/is_device_ptr-2.f90 new file mode 100644 index 0000000..5b7fab0 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/is_device_ptr-2.f90 @@ -0,0 +1,159 @@ +! { dg-additional-options "-fdump-tree-original" } +! +! Since OpenMP 5.1, non-TYPE(c_ptr) arguments to is_device_ptr +! map to has_device_ptr - check this! +! +! PR fortran/105318 +! +module m + use iso_c_binding, only: c_ptr, c_loc, c_f_pointer, c_associated + implicit none (type, external) +contains + subroutine one (as, ar, asp, arp, asa, ara, cptr_a) + integer, target :: AS, AR(5) + integer, pointer :: ASP, ARP(:) + integer, allocatable :: ASA, ARA(:) + + type(c_ptr) :: cptr_a + + !$omp target is_device_ptr(as, ar, asp, arp, asa, ara, cptr_a) + if (.not. c_associated (cptr_a, c_loc(as))) stop 18 + if (as /= 5) stop 19 + if (any (ar /= [1,2,3,4,5])) stop 20 + if (asp /= 9) stop 21 + if (any (arp /= [2,4,6])) stop 22 + !$omp end target + end + + subroutine two (cptr_v) + type(c_ptr), value :: cptr_v + integer, pointer :: xx + + xx => null() + !$omp target is_device_ptr(cptr_v) + if (.not. c_associated (cptr_v)) stop 23 + call c_f_pointer (cptr_v, xx) + if (xx /= 5) stop 24 + xx => null() + !$omp end target + end + + subroutine three (os, or, osp, orp, osa, ora, cptr_o) + integer, optional, target :: OS, OR(5) + integer, optional, pointer :: OSP, ORP(:) + integer, optional, allocatable :: OSA, ORA(:) + + type(c_ptr) :: cptr_o + + !$omp target is_device_ptr(os, or, osp, orp, osa, ora, cptr_o) + if (.not. c_associated (cptr_o, c_loc(os))) stop 25 + if (os /= 5) stop 26 + if (any (or /= [1,2,3,4,5])) stop 27 + if (osp /= 9) stop 28 + if (any (orp /= [2,4,6])) stop 29 + !$omp end target + end + + subroutine four(NVS, NVSO) + use omp_lib, only: omp_initial_device, omp_invalid_device + integer, value :: NVS + integer, optional, value :: NVSO + integer :: NS, NR(5) + logical, volatile :: false_ + + false_ = .false. + + !$omp target is_device_ptr (NS, NR, NVS, NVSO) device(omp_initial_device) + NVS = 5 + NVSO = 5 + NS = 5 + NR(1) = 7 + !$omp end target + + if (false_) then + !$omp target device(omp_invalid_device) + !$omp end target + end if + end subroutine + +end module m + +program main + use iso_c_binding, only: c_ptr, c_loc, c_f_pointer, c_associated + use m + implicit none (type, external) + + integer, target :: IS, IR(5) + integer, pointer :: ISP, IRP(:) + integer, allocatable :: ISA, IRA(:) + integer :: xxx, xxxx + + type(c_ptr) :: cptr_i + + is = 5 + ir = [1,2,3,4,5] + allocate(ISP, source=9) + allocate(IRP, source=[2,4,6]) + + !$omp target data map(is, ir, isp, irp, isa, ira) & + !$omp& use_device_ptr(is, ir, isp, irp, isa, ira) + + cptr_i = c_loc(is) + !$omp target is_device_ptr(is, ir, isp, irp, isa, ira, cptr_i) + if (.not. c_associated (cptr_i, c_loc(is))) stop 30 + if (is /= 5) stop 31 + if (any (ir /= [1,2,3,4,5])) stop 32 + if (isp /= 9) stop 33 + if (any (irp /= [2,4,6])) stop 34 + !$omp end target + + call one (is, ir, isp, irp, isa, ira, cptr_i) + call two (cptr_i) + call three (is, ir, isp, irp, isa, ira, cptr_i) + + !$omp end target data + + call four(xxx, xxxx) +end + +! { dg-final { scan-tree-dump-not "use_device_ptr" "original" } } +! { dg-final { scan-tree-dump "use_device_addr\\(ira\\)" "original" } } +! { dg-final { scan-tree-dump "use_device_addr\\(isa\\)" "original" } } +! { dg-final { scan-tree-dump "use_device_addr\\(irp\\)" "original" } } +! { dg-final { scan-tree-dump "use_device_addr\\(isp\\)" "original" } } +! { dg-final { scan-tree-dump "use_device_addr\\(ir\\)" "original" } } +! { dg-final { scan-tree-dump "use_device_addr\\(is\\)" "original" } } + +! { dg-final { scan-tree-dump-not "use_device_addr\\(cptr" "original" } } +! { dg-final { scan-tree-dump-not "use_device_ptr\\(o" "original" } } +! { dg-final { scan-tree-dump-not "use_device_ptr\\(a" "original" } } +! { dg-final { scan-tree-dump-not "use_device_ptr\\(i" "original" } } + +! { dg-final { scan-tree-dump "is_device_ptr\\(cptr_o\\)" "original" } } +! { dg-final { scan-tree-dump "has_device_addr\\(ora\\)" "original" } } +! { dg-final { scan-tree-dump "has_device_addr\\(osa\\)" "original" } } +! { dg-final { scan-tree-dump "has_device_addr\\(orp\\)" "original" } } +! { dg-final { scan-tree-dump "has_device_addr\\(osp\\)" "original" } } +! { dg-final { scan-tree-dump "has_device_addr\\(or\\)" "original" } } +! { dg-final { scan-tree-dump "has_device_addr\\(os\\)" "original" } } +! { dg-final { scan-tree-dump "is_device_ptr\\(cptr_v\\)" "original" } } +! { dg-final { scan-tree-dump "is_device_ptr\\(cptr_a\\)" "original" } } +! { dg-final { scan-tree-dump "has_device_addr\\(ara\\)" "original" } } +! { dg-final { scan-tree-dump "has_device_addr\\(asa\\)" "original" } } +! { dg-final { scan-tree-dump "has_device_addr\\(arp\\)" "original" } } +! { dg-final { scan-tree-dump "has_device_addr\\(asp\\)" "original" } } +! { dg-final { scan-tree-dump "has_device_addr\\(ar\\)" "original" } } +! { dg-final { scan-tree-dump "has_device_addr\\(as\\)" "original" } } +! { dg-final { scan-tree-dump "use_device_addr\\(is\\)" "original" } } +! { dg-final { scan-tree-dump "use_device_addr\\(ir\\)" "original" } } +! { dg-final { scan-tree-dump "use_device_addr\\(isp\\)" "original" } } +! { dg-final { scan-tree-dump "use_device_addr\\(irp\\)" "original" } } +! { dg-final { scan-tree-dump "use_device_addr\\(isa\\)" "original" } } +! { dg-final { scan-tree-dump "use_device_addr\\(ira\\)" "original" } } +! { dg-final { scan-tree-dump "is_device_ptr\\(cptr_i\\)" "original" } } +! { dg-final { scan-tree-dump "has_device_addr\\(ira\\)" "original" } } +! { dg-final { scan-tree-dump "has_device_addr\\(isa\\)" "original" } } +! { dg-final { scan-tree-dump "has_device_addr\\(irp\\)" "original" } } +! { dg-final { scan-tree-dump "has_device_addr\\(isp\\)" "original" } } +! { dg-final { scan-tree-dump "has_device_addr\\(ir\\)" "original" } } +! { dg-final { scan-tree-dump "has_device_addr\\(is\\)" "original" } } |