https://gcc.gnu.org/g:400d12c7d327c4f3d7d49a867cc70671048ef83d
commit 400d12c7d327c4f3d7d49a867cc70671048ef83d
Author: Tobias Burnus <tbur...@baylibre.com>
Date: Tue Jan 28 12:59:52 2025 +0100
OpenMP: Enable has_device_addr clause for 'dispatch' in Fortran
Fortran version of commit r15-6178-g2cbb2408a830a6 for C/C++.
However, the has_device_addr clause on dispatch only becomes really
useful (for C++ and Fortran) once the 'need_device_addr' modifier
to declare variant's 'adjust_args' clause is supported (i.e. with
a future commit).
gcc/fortran/ChangeLog:
* openmp.cc (OMP_DISPATCH_CLAUSES): Add OMP_CLAUSE_HAS_DEVICE_ADDR.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/adjust-args-10.f90: New test.
(cherry picked from commit f642db74d936e5310e86ce0173c83673a309e440)
Diff:
---
gcc/fortran/ChangeLog.omp | 7 ++
gcc/fortran/openmp.cc | 3 +-
gcc/testsuite/ChangeLog.omp | 7 ++
gcc/testsuite/gfortran.dg/gomp/adjust-args-10.f90 | 99 +++++++++++++++++++++++
4 files changed, 115 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index 396e74ddf173..352d37efdcb9 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,10 @@
+2025-01-28 Tobias Burnus <tbur...@baylibre.com>
+
+ Backported from master:
+ 2025-01-02 Tobias Burnus <tbur...@baylibre.com>
+
+ * openmp.cc (OMP_DISPATCH_CLAUSES): Add OMP_CLAUSE_HAS_DEVICE_ADDR.
+
2025-01-28 Tobias Burnus <tbur...@baylibre.com>
Backported from master:
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 4fb1c3bb09f3..4972a1138306 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -5164,7 +5164,8 @@ cleanup:
| OMP_CLAUSE_INIT | OMP_CLAUSE_DESTROY | OMP_CLAUSE_USE)
#define OMP_DISPATCH_CLAUSES
\
(omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOVARIANTS
\
- | OMP_CLAUSE_NOCONTEXT | OMP_CLAUSE_IS_DEVICE_PTR | OMP_CLAUSE_NOWAIT)
+ | OMP_CLAUSE_NOCONTEXT | OMP_CLAUSE_IS_DEVICE_PTR | OMP_CLAUSE_NOWAIT
\
+ | OMP_CLAUSE_HAS_DEVICE_ADDR)
static match
diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index 9d9082377ea3..310846eec1e1 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,10 @@
+2025-01-28 Tobias Burnus <tbur...@baylibre.com>
+
+ Backported from master:
+ 2025-01-02 Tobias Burnus <tbur...@baylibre.com>
+
+ * gfortran.dg/gomp/adjust-args-10.f90: New test.
+
2025-01-28 Tobias Burnus <tbur...@baylibre.com>
Backported from master:
diff --git a/gcc/testsuite/gfortran.dg/gomp/adjust-args-10.f90
b/gcc/testsuite/gfortran.dg/gomp/adjust-args-10.f90
new file mode 100644
index 000000000000..3b649b5d7d0e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/adjust-args-10.f90
@@ -0,0 +1,99 @@
+! { dg-additional-options "-fdump-tree-gimple" }
+
+! This mainly checks 'has_device_addr' without associated 'need_device_addr'
+!
+! Do diagnostic check / dump check only;
+! Note: this test should work as run-test as well.
+
+module m
+ use iso_c_binding
+ ! use omp_lib
+ implicit none (type, external)
+ interface
+ integer function omp_get_default_device (); end
+ integer function omp_get_num_devices (); end
+ end interface
+
+contains
+ subroutine g (x, y)
+ !$omp declare variant(f) adjust_args(need_device_ptr: x, y)
match(construct={dispatch})
+ type(c_ptr), value :: x, y
+ end
+
+ subroutine f (cfrom, cto)
+ type(c_ptr), value :: cfrom, cto
+ integer, save :: cnt = 0
+ cnt = cnt + 1
+ if (cnt >= 3) then
+ if (omp_get_default_device () /= -1 &
+ .and. omp_get_default_device () < omp_get_num_devices ()) then
+ ! On offload device but not mapped
+ if (.not. c_associated(cfrom)) & ! Not mapped
+ stop 1
+ else
+ block
+ integer, pointer :: from(:)
+ call c_f_pointer(cfrom, from, shape=[1])
+ if (from(1) /= 5) &
+ stop 2
+ end block
+ end if
+ return
+ end if
+
+ !$omp target is_device_ptr(cfrom, cto)
+ block
+ integer, pointer :: from(:), to(:)
+ call c_f_pointer(cfrom, from, shape=[2])
+ call c_f_pointer(cto, to, shape=[2])
+ to(1) = from(1) * 10
+ to(2) = from(2) * 10
+ end block
+ end
+
+ subroutine sub (a, b)
+ integer, target :: a(:), b(:)
+ type(c_ptr), target :: ca, cb
+
+ ca = c_loc(a)
+ cb = c_loc(b)
+
+ ! The has_device_addr is a bit questionable as the caller is not actually
+ ! passing a device address - but we cannot pass one because of the
+ ! following:
+ !
+ ! As for 'b' need_device_ptr has been specified and 'b' is not
+ ! in the semantic requirement set 'is_device_ptr' (and only in
'has_device_addr')
+ ! "the argument is converted in the same manner that a use_device_ptr
clause
+ ! on a target_data construct converts its pointer"
+
+ !$omp dispatch is_device_ptr(ca), has_device_addr(cb)
+ call g (ca, cb) ! { dg-warning "'has_device_addr' for 'cb' does not
imply 'is_device_ptr' required for 'need_device_ptr' \\\[-Wopenmp\\\]" }
+ end
+end
+
+program main
+ use m
+ implicit none (type, external)
+
+ integer, target :: A(2), B(2) = [123, 456], C(1) = [5]
+ integer, pointer :: p(:)
+
+ p => A
+
+ !$omp target enter data map(A, B)
+
+ ! Note: We don't add 'use_device_addr(B)' here;
+ ! if we do, it will fail with an illegal memory access (why?).
+ !$omp target data use_device_ptr(p)
+ call sub(p, B)
+ call sub(C, B) ! C is not mapped -> 'from' ptr == NULL
+ !$omp end target data
+
+ !$omp target exit data map(A, B)
+end
+
+! { dg-final { scan-tree-dump-times "#pragma omp dispatch
is_device_ptr\\(ca\\) has_device_addr\\(cb\\)" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "__builtin_omp_get_mapped_ptr" 1 "gimple"
} }
+! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ =
__builtin_omp_get_mapped_ptr \\(cb" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "f \\(ca\\.\[0-9\]+, D\\.\[0-9\]+\\);" 1
"gimple" } }
