Support the 'has_device_addr' clause with OpenMP's 'dispatch'
directive.
The testcase is even more questionable as the C/C++ testcase
(looking at it globally/semantically), but it tests (locally)
what it is supposed to test: namely, 'has_device_addr' does not
fulfill the 'is_device_ptr' property (warning, tree dump), which
in turn also checks that the clause actually reached the middle
end.
I intent to commit it soon after PA has committed his
"OpenMP: Fortran front-end support for dispatch + adjust_args"
patch.
* * *
As mentioned in the commit logs (C++ and as attached for Fortran),
dispatch's has_device_addr clause only becomes useful once the
'adjust_args' clause of 'declare variant' supports the
'need_device_addr' modifier. - Deferred for C++ and Fortran to
a follow up patch (after understanding the semantic/spec vs.
current implementation/backward compat better; at least for C++,
I believe that there is a bug in the current
{has,use,is}_device_{ptr,addr} code). [As C does not have reference
types, 'need_device_addr' is invalid and, hence, rejected.]
Tobias
OpenMP: Enable has_device_addr clause for 'dispatch' in Fortran
Fortran version of commit r15-6178-g2cbb2408a830a6 for C/C++.
However, this only becomes really useful (for C++ and Fortran) once the
'need_device_addr' modifier to declare variant's 'adjust_args' clause
is supported.
fortran/openmp.cc | 3
testsuite/gfortran.dg/gomp/adjust-args-10.f90 | 99 ++++++++++++++++++++++++++
2 files changed, 101 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 47c1ded4e44..863c96ab64a 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -5018,7 +5018,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/gfortran.dg/gomp/adjust-args-10.f90 b/gcc/testsuite/gfortran.dg/gomp/adjust-args-10.f90
new file mode 100644
index 00000000000..3b649b5d7d0
--- /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" } }
