diff options
author | Tobias Burnus <tobias@codesourcery.com> | 2023-03-01 13:53:09 +0100 |
---|---|---|
committer | Tobias Burnus <tobias@codesourcery.com> | 2023-03-08 10:50:45 +0100 |
commit | fa1e458d05a94d064e8daef88c2be300317d7e8b (patch) | |
tree | da009d4f5e7a38103d6004b8bfb485b878e023de /libgomp | |
parent | d5f1d6ec2df90232d185521d7a5b3c614be017e8 (diff) | |
download | gcc-fa1e458d05a94d064e8daef88c2be300317d7e8b.zip gcc-fa1e458d05a94d064e8daef88c2be300317d7e8b.tar.gz gcc-fa1e458d05a94d064e8daef88c2be300317d7e8b.tar.bz2 |
OpenMP/Fortran: Fix handling of optional is_device_ptr + bind(C) [PR108546]
For is_device_ptr, optional checks should only be done before calling
libgomp, afterwards they are NULL either because of absent or, by
chance, because it is unallocated or unassociated (for pointers/allocatables).
Additionally, it fixes an issue with explicit mapping for 'type(c_ptr)'.
PR middle-end/108546
gcc/fortran/ChangeLog:
* trans-openmp.cc (gfc_trans_omp_clauses): Fix mapping of
type(C_ptr) variables.
gcc/ChangeLog:
* omp-low.cc (lower_omp_target): Remove optional handling
on the receiver side, i.e. inside target (data), for
use_device_ptr.
libgomp/ChangeLog:
* testsuite/libgomp.fortran/is_device_ptr-3.f90: New test.
* testsuite/libgomp.fortran/use_device_ptr-optional-4.f90: New test.
(cherry picked from commit 96ff97ff6574666a5509ae9fa596e7f2b6ad4f88)
Diffstat (limited to 'libgomp')
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/is_device_ptr-3.f90 | 46 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-4.f90 | 53 |
2 files changed, 99 insertions, 0 deletions
diff --git a/libgomp/testsuite/libgomp.fortran/is_device_ptr-3.f90 b/libgomp/testsuite/libgomp.fortran/is_device_ptr-3.f90 new file mode 100644 index 0000000..ab9f00e --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/is_device_ptr-3.f90 @@ -0,0 +1,46 @@ +module m + use iso_c_binding + implicit none +contains + subroutine s(x,y,z) + type(c_ptr), optional :: x + integer, pointer, optional :: y + integer, allocatable, optional :: z + logical is_present, is_null + is_present = present(x) + if (is_present) & + is_null = .not. c_associated(x) + + !$omp target is_device_ptr(x) has_device_addr(y) has_device_addr(z) + if (is_present) then + if (is_null) then + if (c_associated(x)) stop 1 + if (associated(y)) stop 2 + if (allocated(z)) stop 3 + else + if (.not. c_associated(x, c_loc(y))) stop 4 + if (y /= 7) stop 5 + if (z /= 9) stop 6 + end if + end if + !$omp end target + end +end + +use m +implicit none +integer, pointer :: p +integer, allocatable :: a +p => null() +call s() +!$omp target data map(p,a) use_device_addr(p,a) + call s(c_null_ptr, p, a) +!$omp end target data +allocate(p,a) +p = 7 +a = 9 +!$omp target data map(p,a) use_device_addr(p,a) + call s(c_loc(p), p, a) +!$omp end target data +deallocate(p,a) +end diff --git a/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-4.f90 b/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-4.f90 new file mode 100644 index 0000000..b2a5c31 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-4.f90 @@ -0,0 +1,53 @@ +! PR middle-end/108546 +! +module m + use iso_c_binding + implicit none + type(c_ptr) :: p2, p3 +contains + subroutine s(x,y,z) + type(c_ptr), optional :: x + integer, pointer, optional :: y + integer, allocatable, optional, target :: z + logical is_present, is_null + is_present = present(x) + if (is_present) & + is_null = .not. c_associated(x) + + !$omp target data use_device_ptr(x) use_device_addr(y) use_device_addr(z) + if (is_present) then + if (is_null) then + if (c_associated(x)) stop 1 + if (associated(y)) stop 2 + if (allocated(z)) stop 3 + else + if (.not. c_associated(x, p2)) stop 4 + if (.not. c_associated(c_loc(y), p2)) stop 5 + if (.not. c_associated(c_loc(z), p3)) stop 6 + end if + end if + !$omp end target data + end +end + +use m +implicit none +type(c_ptr) :: cp +integer, pointer :: p +integer, allocatable, target :: a +call s() +p => null() +call s(c_null_ptr, p, a) +allocate(p,a) +p = 7 +a = 9 +cp = c_loc(p) +!$omp target enter data map(to: cp, p, a) +!$omp target map(from: p2, p3) + p2 = c_loc(p) + p3 = c_loc(a) +!$omp end target +call s(cp, p, a) +!$omp target exit data map(delete: cp, p, a) +deallocate(p,a) +end |