mirror of
https://forge.sourceware.org/marek/gcc.git
synced 2026-02-22 03:47:02 -05:00
a57b0e3ecb
Bumps OpenMP from 4.5 (201511) to 5.2 (202111), with deprecation and
test support to 5.1 (202011). Adds new tests and a new warning.
Suppresses deprecation warnings in all relevant tests and removes
suppression pragmas visible outside of the testsuite. Additionally
implements new warning in the relevant frontends. Otherwise, cleans
up some whitespace and fixed a misspelled pragma in a testcase. Also
fixes an indentation error.
gcc/c-family/ChangeLog:
* c-cppbuiltin.cc (c_cpp_builtins): Bump _OPENMP version.
* c.opt (Wdeprecated-openmp): Add warning.
* c.opt.urls: Regenerated.
gcc/c/ChangeLog:
* c-parser.cc (c_parser_omp_clause_proc_bind): Deprecate master
affinity.
(c_parser_omp_master): Deprecate master construct.
(c_parser_transaction): Whitespace.
gcc/cp/ChangeLog:
* parser.cc (cp_parser_postfix_expression): Whitespace.
(cp_parser_builtin_c23_va_start): Ditto.
(cp_parser_omp_clause_proc_bind): Deprecate master affinity.
(cp_parser_omp_master): Deprecate master construct.
gcc/ChangeLog:
* doc/invoke.texi: Update docs for '-Wdeprecated-openmp'.
gcc/fortran/ChangeLog:
* cpp.cc (cpp_define_builtins): Bump _OPENMP version.
* invoke.texi: Update docs for '-Wdeprecated-openmp'.
* lang.opt (Wdeprecated-openmp): Add warning.
* lang.opt.urls: Regenerated.
* openmp.cc (gfc_match_omp_clauses): Deprecate master affinity
policy.
(gfc_match_omp_parallel_master): Deprecate master construct.
(gfc_match_omp_parallel_master_taskloop): Ditto.
(gfc_match_omp_parallel_master_taskloop_simd): Ditto.
(gfc_match_omp_master): Ditto.
(gfc_match_omp_master_taskloop): Ditto.
(gfc_match_omp_master_taskloop_simd): Ditto.
(resolve_omp_clauses): Warn for deprecated use of
{use,is}_device_ptr.
libgomp/ChangeLog:
* env.c (omp_display_env): Bump _OPENMP version.
* fortran.c (ialias_redirect): Remove suppression pragmas.
(omp_set_dynamic_8_): Ditto.
(omp_set_nested_8_): Ditto.
(omp_get_nested_): Ditto.
* icv.c (omp_get_dynamic): Ditto.
(omp_get_nested): Ditto.
(ialias): Ditto.
* omp_lib.f90.in: Bump openmp_version.
* omp_lib.h.in: Ditto.
* testsuite/libgomp.c++/affinity-1.C: Suppress deprecation
warnings.
* testsuite/libgomp.c++/ctor-1.C: Ditto.
* testsuite/libgomp.c++/ctor-11.C: Ditto.
* testsuite/libgomp.c++/ctor-13.C: Ditto.
* testsuite/libgomp.c++/ctor-2.C: Ditto.
* testsuite/libgomp.c++/ctor-5.C: Ditto.
* testsuite/libgomp.c++/ctor-7.C: Ditto.
* testsuite/libgomp.c++/depend-iterator-1.C: Ditto.
* testsuite/libgomp.c++/loop-13.C: Ditto.
* testsuite/libgomp.c++/master-1.C: Ditto.
* testsuite/libgomp.c++/pr26943.C: Ditto.
* testsuite/libgomp.c++/pr81130.C: Ditto.
* testsuite/libgomp.c++/pr81314.C: Ditto.
* testsuite/libgomp.c++/target-in-reduction-1.C: Ditto.
* testsuite/libgomp.c++/target-in-reduction-2.C: Ditto.
* testsuite/libgomp.c++/task-1.C: Ditto.
* testsuite/libgomp.c++/task-2.C: Ditto.
* testsuite/libgomp.c++/task-6.C: Ditto.
* testsuite/libgomp.c++/task-reduction-7.C: Ditto.
* testsuite/libgomp.c++/task-reduction-9.C: Ditto.
* testsuite/libgomp.c++/taskloop-reduction-1.C: Ditto.
* testsuite/libgomp.c-c++-common/cancel-taskgroup-4.c: Ditto.
* testsuite/libgomp.c-c++-common/depend-inoutset-1.c: Ditto.
* testsuite/libgomp.c-c++-common/depend-iterator-1.c: Ditto.
* testsuite/libgomp.c-c++-common/master-combined-1.c: Ditto.
* testsuite/libgomp.c-c++-common/target-in-reduction-1.c: Ditto.
* testsuite/libgomp.c-c++-common/target-in-reduction-2.c: Ditto.
* testsuite/libgomp.c-c++-common/task-detach-12.c: Ditto.
* testsuite/libgomp.c-c++-common/task-reduction-15.c: Ditto.
* testsuite/libgomp.c-c++-common/task-reduction-5.c: Ditto.
* testsuite/libgomp.c-c++-common/task-reduction-6.c: Ditto.
* testsuite/libgomp.c-c++-common/task-reduction-8.c: Ditto.
* testsuite/libgomp.c-c++-common/taskloop-reduction-1.c: Ditto.
* testsuite/libgomp.c-c++-common/taskloop-reduction-3.c: Ditto.
* testsuite/libgomp.c-c++-common/taskloop-reduction-4.c: Ditto.
* testsuite/libgomp.c/affinity-1.c: Remove extraneous dg
instruction and add suppression.
* testsuite/libgomp.c/critical-2.c: Suppress deprecation
warnings.
* testsuite/libgomp.c/debug-1.c: Ditto.
* testsuite/libgomp.c/lib-1.c: Ditto.
* testsuite/libgomp.c/loop-24.c: Ditto.
* testsuite/libgomp.c/nestedfn-2.c: Ditto.
* testsuite/libgomp.c/nestedfn-3.c: Ditto.
* testsuite/libgomp.c/pr104385.c: Ditto.
* testsuite/libgomp.c/target-31.c: Ditto.
* testsuite/libgomp.c/target-34.c: Ditto.
* testsuite/libgomp.c/target-critical-1.c: Ditto.
* testsuite/libgomp.c/task-1.c: Ditto.
* testsuite/libgomp.c/task-3.c: Ditto.
* testsuite/libgomp.c/task-6.c: Ditto.
* testsuite/libgomp.c/task-reduction-1.c: Ditto.
* testsuite/libgomp.c/task-reduction-2.c: Ditto.
* testsuite/libgomp.c/teams-1.c: Ditto.
* testsuite/libgomp.c/vla-1.c: Ditto.
* testsuite/libgomp.fortran/crayptr1.f90: Ditto.
* testsuite/libgomp.fortran/depend-inoutset-1.f90: Ditto.
* testsuite/libgomp.fortran/is_device_ptr-1.f90: Ditto.
* testsuite/libgomp.fortran/is_device_ptr-2.f90: Ditto.
* testsuite/libgomp.fortran/lib1.f90: Ditto.
* testsuite/libgomp.fortran/lib2.f: Ditto.
* testsuite/libgomp.fortran/lib3.f: Ditto.
* testsuite/libgomp.fortran/omp_parse2.f90: Ditto.
* testsuite/libgomp.fortran/openmp_version-1.f: Bump OMP version.
* testsuite/libgomp.fortran/openmp_version-2.f90: Ditto.
* testsuite/libgomp.fortran/parallel-master.f90: Suppress
warnings.
* testsuite/libgomp.fortran/pointer2.f90: Ditto.
* testsuite/libgomp.fortran/reduction6.f90: Ditto.
* testsuite/libgomp.fortran/target-firstprivate-1.f90: Ditto.
* testsuite/libgomp.fortran/use_device_addr-1.f90: Ditto.
* testsuite/libgomp.fortran/use_device_addr-2.f90: Ditto.
* testsuite/libgomp.fortran/use_device_addr-3.f90: Ditto.
* testsuite/libgomp.fortran/use_device_addr-4.f90: Ditto.
* testsuite/libgomp.fortran/use_device_addr-5.f90: Ditto.
* testsuite/libgomp.fortran/use_device_ptr-1.f90: Ditto.
* testsuite/libgomp.fortran/use_device_ptr-3.f90: Ditto.
* testsuite/libgomp.fortran/use_device_ptr-4.f90: Ditto.
* testsuite/libgomp.fortran/use_device_ptr-optional-1.f90: Ditto.
* testsuite/libgomp.fortran/use_device_ptr-optional-2.f90: Ditto.
* testsuite/libgomp.fortran/use_device_ptr-optional-3.f90: Ditto.
* testsuite/libgomp.c-c++-common/omp-atv-seq-dep.c: New test.
* testsuite/libgomp.c-c++-common/omp-lock-hint-contended-dep.c:
New test.
* testsuite/libgomp.c-c++-common/omp-lock-hint-none-dep.c: New test.
* testsuite/libgomp.c-c++-common/omp-lock-hint-speculative-dep.c:
New test.
* testsuite/libgomp.c-c++-common/omp-lock-hint-uncontended-dep.c:
New test.
* testsuite/libgomp.c/omp-proc-bind-master-dep.c: New test.
* testsuite/libgomp.fortran/omp-atv-seq-dep.f90: New test.
* testsuite/libgomp.fortran/omp-lock-hint-contended-dep.f90: New
test.
* testsuite/libgomp.fortran/omp-lock-hint-none-dep.f90: New test.
* testsuite/libgomp.fortran/omp-lock-hint-speculative-dep.f90: New
test.
* testsuite/libgomp.fortran/omp-lock-hint-uncontended-dep.f90: New
test.
gcc/testsuite/ChangeLog:
* c-c++-common/cpp/openmp-define-3.c: Bump OMP version.
* c-c++-common/gomp/Wparentheses-1.c: Suppress deprecation
warnings.
* c-c++-common/gomp/Wparentheses-3.c: Ditto.
* c-c++-common/gomp/affinity-3.c: Ditto.
* c-c++-common/gomp/allocate-18.c: Ditto.
* c-c++-common/gomp/cancel-1.c: Ditto.
* c-c++-common/gomp/clause-dups-1.c: Ditto.
* c-c++-common/gomp/clauses-1.c: Suppress deprecation
warnings and fix misspelled directive. Add
'-Wunknown-pragmas'.
* c-c++-common/gomp/clauses-6.c: Suppress deprecation warnings.
* c-c++-common/gomp/declare-variant-1.c: Ditto.
* c-c++-common/gomp/declare-variant-2.c: Ditto.
* c-c++-common/gomp/depend-iterator-1.c: Ditto.
* c-c++-common/gomp/lastprivate-conditional-1.c: Ditto.
* c-c++-common/gomp/loop-1.c: Ditto.
* c-c++-common/gomp/loop-2.c: Ditto.
* c-c++-common/gomp/loop-3.c: Ditto.
* c-c++-common/gomp/loop-4.c: Ditto.
* c-c++-common/gomp/master-combined-1.c: Ditto.
* c-c++-common/gomp/master-combined-2.c: Ditto.
* c-c++-common/gomp/nesting-2.c: Ditto.
* c-c++-common/gomp/pr100902-1.c: Ditto.
* c-c++-common/gomp/pr61486-2.c: Ditto.
* c-c++-common/gomp/pr85696.c: Ditto.
* c-c++-common/gomp/pr85956.c: Ditto.
* c-c++-common/gomp/pr98187.c: Ditto.
* c-c++-common/gomp/pr99928-1.c: Ditto.
* c-c++-common/gomp/pr99928-10.c: Ditto.
* c-c++-common/gomp/pr99928-11.c: Ditto.
* c-c++-common/gomp/pr99928-12.c: Ditto.
* c-c++-common/gomp/pr99928-13.c: Ditto.
* c-c++-common/gomp/pr99928-14.c: Ditto.
* c-c++-common/gomp/pr99928-2.c: Ditto.
* c-c++-common/gomp/pr99928-3.c: Ditto.
* c-c++-common/gomp/pr99928-4.c: Ditto.
* c-c++-common/gomp/pr99928-5.c: Ditto.
* c-c++-common/gomp/pr99928-6.c: Ditto.
* c-c++-common/gomp/pr99928-7.c: Ditto.
* c-c++-common/gomp/pr99928-8.c: Ditto.
* c-c++-common/gomp/pr99928-9.c: Ditto.
* c-c++-common/gomp/task-detach-1.c: Ditto.
* c-c++-common/gomp/teams-2.c: Ditto.
* g++.dg/gomp/attrs-1.C: Ditto.
* g++.dg/gomp/attrs-2.C: Ditto.
* g++.dg/gomp/attrs-4.C: Ditto.
* g++.dg/gomp/block-0.C: Ditto.
* g++.dg/gomp/block-10.C: Ditto.
* g++.dg/gomp/block-5.C: Ditto.
* g++.dg/gomp/block-9.C: Ditto.
* g++.dg/gomp/depend-iterator-1.C: Ditto.
* g++.dg/gomp/master-1.C: Ditto.
* g++.dg/gomp/master-2.C: Ditto.
* g++.dg/gomp/master-3.C: Ditto.
* g++.dg/gomp/method-1.C: Ditto.
* g++.dg/gomp/pr29965-3.C: Ditto.
* g++.dg/gomp/pr29965-9.C: Ditto.
* g++.dg/gomp/pr78363-4.C: Ditto.
* g++.dg/gomp/pr78363-6.C: Ditto.
* g++.dg/gomp/pr79664.C: Ditto.
* g++.dg/gomp/pr94477.C: Ditto.
* g++.dg/gomp/pr94512.C: Ditto.
* g++.dg/gomp/tpl-master-1.C: Ditto.
* gcc.dg/gomp/appendix-a/a.12.1.c: Ditto.
* gcc.dg/gomp/appendix-a/a.33.2.c: Ditto.
* gcc.dg/gomp/attrs-1.c: Ditto.
* gcc.dg/gomp/attrs-2.c: Ditto.
* gcc.dg/gomp/attrs-4.c: Ditto.
* gcc.dg/gomp/block-10.c: Ditto.
* gcc.dg/gomp/block-5.c: Ditto.
* gcc.dg/gomp/block-9.c: Ditto.
* gcc.dg/gomp/master-1.c: Ditto.
* gcc.dg/gomp/master-2.c: Ditto.
* gcc.dg/gomp/master-3.c: Ditto.
* gcc.dg/gomp/nesting-1.c: Ditto.
* gcc.dg/gomp/pr104517.c: Ditto.
* gcc.dg/gomp/pr29965-3.c: Ditto.
* gcc.dg/gomp/pr35818.c: Ditto.
* gcc.dg/gomp/pr91216.c: Ditto.
* gcc.dg/gomp/sharing-2.c: Ditto.
* gfortran.dg/gomp/adjust-args-10.f90: Ditto.
* gfortran.dg/gomp/affinity-1.f90: Ditto.
* gfortran.dg/gomp/allocate-clause.f90: Ditto.
* gfortran.dg/gomp/appendix-a/a.12.1.f90: Ditto.
* gfortran.dg/gomp/appendix-a/a.33.2.f90: Ditto.
* gfortran.dg/gomp/c_ptr_tests_20.f90: Ditto.
* gfortran.dg/gomp/c_ptr_tests_21.f90: Ditto.
* gfortran.dg/gomp/cancel-1.f90: Ditto.
* gfortran.dg/gomp/clauses-1.f90: Ditto.
* gfortran.dg/gomp/declare-variant-1.f90: Ditto.
* gfortran.dg/gomp/depend-iterator-1.f90: Ditto.
* gfortran.dg/gomp/depend-iterator-2.f90: Ditto.
* gfortran.dg/gomp/is_device_ptr-1.f90: Ditto.
* gfortran.dg/gomp/is_device_ptr-2.f90: Ditto.
* gfortran.dg/gomp/is_device_ptr-3.f90: Ditto.
* gfortran.dg/gomp/lastprivate-conditional-1.f90: Ditto.
* gfortran.dg/gomp/loop-4.f90: Ditto.
* gfortran.dg/gomp/loop-exit.f90: Ditto.
* gfortran.dg/gomp/map-3.f90: Ditto.
* gfortran.dg/gomp/nesting-2.f90: Ditto.
* gfortran.dg/gomp/nesting-3.f90: Ditto.
* gfortran.dg/gomp/nowait-2.f90: Ditto.
* gfortran.dg/gomp/nowait-4.f90: Ditto.
* gfortran.dg/gomp/nowait-5.f90: Ditto.
* gfortran.dg/gomp/openmp-simd-2.f90: Ditto.
* gfortran.dg/gomp/openmp-simd-3.f90: Ditto.
* gfortran.dg/gomp/parallel-master-1.f90: Ditto.
* gfortran.dg/gomp/parallel-master-2.f90: Ditto.
* gfortran.dg/gomp/pr107214-8.f90: Ditto.
* gfortran.dg/gomp/pr48117.f90: Ditto.
* gfortran.dg/gomp/pr94672.f90: Ditto.
* gfortran.dg/gomp/pr99928-1.f90: Suppression + fix whitespace.
* gfortran.dg/gomp/pr99928-11.f90: Suppression.
* gfortran.dg/gomp/pr99928-2.f90: Suppression + fix whitespace.
* gfortran.dg/gomp/pr99928-3.f90: Ditto.
* gfortran.dg/gomp/pr99928-4.f90: Ditto.
* gfortran.dg/gomp/pr99928-5.f90: Ditto.
* gfortran.dg/gomp/pr99928-6.f90: Ditto.
* gfortran.dg/gomp/pr99928-8.f90: Ditto.
* gfortran.dg/gomp/sharing-3.f90: Suppress deprecation warnings.
* gfortran.dg/gomp/strictly-structured-block-1.f90: Ditto.
* gfortran.dg/gomp/strictly-structured-block-2.f90: Ditto.
* gfortran.dg/gomp/target1.f90: Ditto.
* gfortran.dg/gomp/taskloop-1.f90: Ditto.
* gfortran.dg/gomp/taskloop-2.f90: Ditto.
* gfortran.dg/openmp-define-3.f90: Bump expected version.
* c-c++-common/gomp/master-construct-dep.c: New test.
* gfortran.dg/gomp/master-construct-dep.f90: New test.
793 lines
29 KiB
Fortran
793 lines
29 KiB
Fortran
! { dg-do run }
|
|
! { dg-additional-options "-Wno-deprecated-openmp" }
|
|
! Comprehensive run-time test for use_device_addr
|
|
!
|
|
! Tests array with array descriptor
|
|
!
|
|
! Differs from use_device_addr-4.f90 by using a 8-byte variable (c_double)
|
|
!
|
|
! This test case assumes that a 'var' appearing in 'use_device_addr' is
|
|
! only used as 'c_loc(var)' - such that only the actual data is used/usable
|
|
! on the device - and not meta data ((dynamic) type information, 'present()'
|
|
! status, array shape).
|
|
!
|
|
! Untested in this test case are:
|
|
! - scalars
|
|
! - polymorphic variables
|
|
! - absent optional arguments
|
|
!
|
|
module target_procs
|
|
use iso_c_binding
|
|
implicit none (type, external)
|
|
private
|
|
public :: copy3_array
|
|
contains
|
|
subroutine copy3_array_int(from_ptr, to_ptr, N)
|
|
!$omp declare target
|
|
real(c_double) :: from_ptr(:)
|
|
real(c_double) :: to_ptr(:)
|
|
integer, value :: N
|
|
integer :: i
|
|
|
|
!$omp parallel do
|
|
do i = 1, N
|
|
to_ptr(i) = 3 * from_ptr(i)
|
|
end do
|
|
!$omp end parallel do
|
|
end subroutine copy3_array_int
|
|
|
|
subroutine copy3_array(from, to, N)
|
|
type(c_ptr), value :: from, to
|
|
integer, value :: N
|
|
real(c_double), pointer :: from_ptr(:), to_ptr(:)
|
|
|
|
call c_f_pointer(from, from_ptr, shape=[N])
|
|
call c_f_pointer(to, to_ptr, shape=[N])
|
|
|
|
call do_offload_scalar(from_ptr,to_ptr)
|
|
contains
|
|
subroutine do_offload_scalar(from_r, to_r)
|
|
real(c_double), target :: from_r(:), to_r(:)
|
|
! The extra function is needed as is_device_ptr
|
|
! requires non-value, non-pointer dummy arguments
|
|
|
|
!$omp target is_device_ptr(from_r, to_r)
|
|
call copy3_array_int(from_r, to_r, N)
|
|
!$omp end target
|
|
end subroutine do_offload_scalar
|
|
end subroutine copy3_array
|
|
end module target_procs
|
|
|
|
|
|
|
|
! Test local dummy arguments (w/o optional)
|
|
module test_dummies
|
|
use iso_c_binding
|
|
use target_procs
|
|
implicit none (type, external)
|
|
private
|
|
public :: test_dummy_call_1, test_dummy_call_2
|
|
contains
|
|
subroutine test_dummy_call_1()
|
|
integer, parameter :: N = 1000
|
|
|
|
real(c_double), target :: aa(N), bb(N)
|
|
real(c_double), target, allocatable :: cc(:), dd(:)
|
|
real(c_double), pointer :: ee(:), ff(:)
|
|
|
|
allocate(cc(N), dd(N), ee(N), ff(N))
|
|
|
|
aa = 11.0_c_double
|
|
bb = 22.0_c_double
|
|
cc = 33.0_c_double
|
|
dd = 44.0_c_double
|
|
ee = 55.0_c_double
|
|
ff = 66.0_c_double
|
|
|
|
call test_dummy_callee_1(aa, bb, cc, dd, ee, ff, N)
|
|
deallocate(ee, ff) ! pointers, only
|
|
end subroutine test_dummy_call_1
|
|
|
|
subroutine test_dummy_callee_1(aa, bb, cc, dd, ee, ff, N)
|
|
real(c_double), target :: aa(:), bb(:)
|
|
real(c_double), target, allocatable :: cc(:), dd(:)
|
|
real(c_double), pointer :: ee(:), ff(:)
|
|
|
|
integer, value :: N
|
|
|
|
!$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb)
|
|
call copy3_array(c_loc(aa), c_loc(bb), N)
|
|
!$omp end target data
|
|
if (any(abs(aa - 11.0_c_double) > 10.0_c_double * epsilon(aa))) stop 2
|
|
if (any(abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa))) stop 3
|
|
|
|
!$omp target data map(to:cc) map(from:dd) use_device_addr(cc,dd)
|
|
call copy3_array(c_loc(cc), c_loc(dd), N)
|
|
!$omp end target data
|
|
if (any(abs(cc - 33.0_c_double) > 10.0_c_double * epsilon(cc))) stop 4
|
|
if (any(abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc))) stop 5
|
|
|
|
!$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff)
|
|
call copy3_array(c_loc(ee), c_loc(ff), N)
|
|
!$omp end target data
|
|
if (any(abs(ee - 55.0_c_double) > 10.0_c_double * epsilon(ee))) stop 6
|
|
if (any(abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee))) stop 7
|
|
end subroutine test_dummy_callee_1
|
|
|
|
! Save device ptr - and recall pointer
|
|
subroutine test_dummy_call_2()
|
|
integer, parameter :: N = 1000
|
|
|
|
real(c_double), target :: aa(N), bb(N)
|
|
real(c_double), target, allocatable :: cc(:), dd(:)
|
|
real(c_double), pointer :: ee(:), ff(:)
|
|
|
|
type(c_ptr) :: c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr
|
|
real(c_double), pointer :: aptr(:), bptr(:), cptr(:), dptr(:), eptr(:), fptr(:)
|
|
|
|
allocate(cc(N), dd(N), ee(N), ff(N))
|
|
|
|
call test_dummy_callee_2(aa, bb, cc, dd, ee, ff, &
|
|
c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, &
|
|
aptr, bptr, cptr, dptr, eptr, fptr, &
|
|
N)
|
|
deallocate(ee, ff)
|
|
end subroutine test_dummy_call_2
|
|
|
|
subroutine test_dummy_callee_2(aa, bb, cc, dd, ee, ff, &
|
|
c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, &
|
|
aptr, bptr, cptr, dptr, eptr, fptr, &
|
|
N)
|
|
real(c_double), target :: aa(:), bb(:)
|
|
real(c_double), target, allocatable :: cc(:), dd(:)
|
|
real(c_double), pointer :: ee(:), ff(:)
|
|
|
|
type(c_ptr) :: c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr
|
|
real(c_double), pointer :: aptr(:), bptr(:), cptr(:), dptr(:), eptr(:), fptr(:)
|
|
|
|
integer, value :: N
|
|
|
|
real(c_double) :: dummy
|
|
|
|
aa = 111.0_c_double
|
|
bb = 222.0_c_double
|
|
cc = 333.0_c_double
|
|
dd = 444.0_c_double
|
|
ee = 555.0_c_double
|
|
ff = 666.0_c_double
|
|
|
|
!$omp target data map(to:aa) map(from:bb)
|
|
!$omp target data map(alloc:dummy) use_device_addr(aa,bb)
|
|
c_aptr = c_loc(aa)
|
|
c_bptr = c_loc(bb)
|
|
aptr => aa
|
|
bptr => bb
|
|
!$omp end target data
|
|
|
|
! check c_loc ptr once
|
|
call copy3_array(c_aptr, c_bptr, N)
|
|
!$omp target update from(bb)
|
|
if (any(abs(aa - 111.0_c_double) > 10.0_c_double * epsilon(aa))) stop 8
|
|
if (any(abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa))) stop 9
|
|
|
|
! check c_loc ptr again after target-value modification
|
|
aa = 1111.0_c_double
|
|
!$omp target update to(aa)
|
|
call copy3_array(c_aptr, c_bptr, N)
|
|
!$omp target update from(bb)
|
|
if (any(abs(aa - 1111.0_c_double) > 10.0_c_double * epsilon(aa))) stop 10
|
|
if (any(abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa))) stop 11
|
|
|
|
! check Fortran pointer after target-value modification
|
|
aa = 11111.0_c_double
|
|
!$omp target update to(aa)
|
|
call copy3_array(c_loc(aptr), c_loc(bptr), N)
|
|
!$omp target update from(bb)
|
|
if (any(abs(aa - 11111.0_c_double) > 10.0_c_double * epsilon(aa))) stop 12
|
|
if (any(abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa))) stop 13
|
|
!$omp end target data
|
|
|
|
if (any(abs(aa - 11111.0_c_double) > 10.0_c_double * epsilon(aa))) stop 14
|
|
if (any(abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa))) stop 15
|
|
|
|
|
|
!$omp target data map(to:cc) map(from:dd)
|
|
!$omp target data map(alloc:dummy) use_device_addr(cc,dd)
|
|
c_cptr = c_loc(cc)
|
|
c_dptr = c_loc(dd)
|
|
cptr => cc
|
|
dptr => dd
|
|
!$omp end target data
|
|
|
|
! check c_loc ptr once
|
|
call copy3_array(c_cptr, c_dptr, N)
|
|
!$omp target update from(dd)
|
|
if (any(abs(cc - 333.0_c_double) > 10.0_c_double * epsilon(cc))) stop 16
|
|
if (any(abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc))) stop 17
|
|
|
|
! check c_loc ptr again after target-value modification
|
|
cc = 3333.0_c_double
|
|
!$omp target update to(cc)
|
|
call copy3_array(c_cptr, c_dptr, N)
|
|
!$omp target update from(dd)
|
|
if (any(abs(cc - 3333.0_c_double) > 10.0_c_double * epsilon(cc))) stop 18
|
|
if (any(abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc))) stop 19
|
|
|
|
! check Fortran pointer after target-value modification
|
|
cc = 33333.0_c_double
|
|
!$omp target update to(cc)
|
|
call copy3_array(c_loc(cptr), c_loc(dptr), N)
|
|
!$omp target update from(dd)
|
|
if (any(abs(cc - 33333.0_c_double) > 10.0_c_double * epsilon(cc))) stop 20
|
|
if (any(abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc))) stop 21
|
|
!$omp end target data
|
|
|
|
if (any(abs(cc - 33333.0_c_double) > 10.0_c_double * epsilon(dd))) stop 22
|
|
if (any(abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(dd))) stop 23
|
|
|
|
|
|
!$omp target data map(to:ee) map(from:ff)
|
|
!$omp target data map(alloc:dummy) use_device_addr(ee,ff)
|
|
c_eptr = c_loc(ee)
|
|
c_fptr = c_loc(ff)
|
|
eptr => ee
|
|
fptr => ff
|
|
!$omp end target data
|
|
|
|
! check c_loc ptr once
|
|
call copy3_array(c_eptr, c_fptr, N)
|
|
!$omp target update from(ff)
|
|
if (any(abs(ee - 555.0_c_double) > 10.0_c_double * epsilon(ee))) stop 24
|
|
if (any(abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee))) stop 25
|
|
|
|
! check c_loc ptr again after target-value modification
|
|
ee = 5555.0_c_double
|
|
!$omp target update to(ee)
|
|
call copy3_array(c_eptr, c_fptr, N)
|
|
!$omp target update from(ff)
|
|
if (any(abs(ee - 5555.0_c_double) > 10.0_c_double * epsilon(ee))) stop 26
|
|
if (any(abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee))) stop 27
|
|
|
|
! check Fortran pointer after target-value modification
|
|
ee = 55555.0_c_double
|
|
!$omp target update to(ee)
|
|
call copy3_array(c_loc(eptr), c_loc(fptr), N)
|
|
!$omp target update from(ff)
|
|
if (any(abs(ee - 55555.0_c_double) > 10.0_c_double * epsilon(ee))) stop 28
|
|
if (any(abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ff))) stop 29
|
|
!$omp end target data
|
|
|
|
if (any(abs(ee - 55555.0_c_double) > 10.0_c_double * epsilon(ee))) stop 30
|
|
if (any(abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee))) stop 31
|
|
end subroutine test_dummy_callee_2
|
|
end module test_dummies
|
|
|
|
|
|
|
|
! Test local dummy arguments + OPTIONAL
|
|
! Values present and ptr associated to nonzero
|
|
module test_dummies_opt
|
|
use iso_c_binding
|
|
use target_procs
|
|
implicit none (type, external)
|
|
private
|
|
public :: test_dummy_opt_call_1, test_dummy_opt_call_2
|
|
contains
|
|
subroutine test_dummy_opt_call_1()
|
|
integer, parameter :: N = 1000
|
|
|
|
real(c_double), target :: aa(N), bb(N)
|
|
real(c_double), target, allocatable :: cc(:), dd(:)
|
|
real(c_double), pointer :: ee(:), ff(:)
|
|
|
|
allocate(cc(N), dd(N), ee(N), ff(N))
|
|
|
|
aa = 11.0_c_double
|
|
bb = 22.0_c_double
|
|
cc = 33.0_c_double
|
|
dd = 44.0_c_double
|
|
ee = 55.0_c_double
|
|
ff = 66.0_c_double
|
|
|
|
call test_dummy_opt_callee_1(aa, bb, cc, dd, ee, ff, N)
|
|
call test_dummy_opt_callee_1_absent(N=N)
|
|
deallocate(ee, ff) ! pointers, only
|
|
end subroutine test_dummy_opt_call_1
|
|
|
|
subroutine test_dummy_opt_callee_1(aa, bb, cc, dd, ee, ff, N)
|
|
! scalars
|
|
real(c_double), optional, target :: aa(:), bb(:)
|
|
real(c_double), optional, target, allocatable :: cc(:), dd(:)
|
|
real(c_double), optional, pointer :: ee(:), ff(:)
|
|
|
|
integer, value :: N
|
|
|
|
! All shall be present - and pointing to non-NULL
|
|
if (.not.present(aa) .or. .not.present(bb)) stop 32
|
|
if (.not.present(cc) .or. .not.present(dd)) stop 33
|
|
if (.not.present(ee) .or. .not.present(ff)) stop 34
|
|
|
|
if (.not.allocated(cc) .or. .not.allocated(dd)) stop 35
|
|
if (.not.associated(ee) .or. .not.associated(ff)) stop 36
|
|
|
|
!$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb)
|
|
if (.not.present(aa) .or. .not.present(bb)) stop 37
|
|
if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) stop 38
|
|
call copy3_array(c_loc(aa), c_loc(bb), N)
|
|
!$omp end target data
|
|
if (any(abs(aa - 11.0_c_double) > 10.0_c_double * epsilon(aa))) stop 39
|
|
if (any(abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa))) stop 40
|
|
|
|
!$omp target data map(to:cc) map(from:dd) use_device_addr(cc,dd)
|
|
if (.not.present(cc) .or. .not.present(dd)) stop 41
|
|
if (.not.allocated(cc) .or. .not.allocated(dd)) stop 42
|
|
if (.not.c_associated(c_loc(cc)) .or. .not.c_associated(c_loc(dd))) stop 43
|
|
call copy3_array(c_loc(cc), c_loc(dd), N)
|
|
!$omp end target data
|
|
if (any(abs(cc - 33.0_c_double) > 10.0_c_double * epsilon(cc))) stop 44
|
|
if (any(abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc))) stop 45
|
|
|
|
!$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff)
|
|
if (.not.present(ee) .or. .not.present(ff)) stop 46
|
|
if (.not.associated(ee) .or. .not.associated(ff)) stop 47
|
|
if (.not.c_associated(c_loc(ee)) .or. .not.c_associated(c_loc(ff))) stop 48
|
|
call copy3_array(c_loc(ee), c_loc(ff), N)
|
|
!$omp end target data
|
|
if (any(abs(ee - 55.0_c_double) > 10.0_c_double * epsilon(ee))) stop 49
|
|
if (any(abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee))) stop 50
|
|
end subroutine test_dummy_opt_callee_1
|
|
|
|
subroutine test_dummy_opt_callee_1_absent(aa, bb, cc, dd, ee, ff, N)
|
|
! scalars
|
|
real(c_double), optional, target :: aa(:), bb(:)
|
|
real(c_double), optional, target, allocatable :: cc(:), dd(:)
|
|
real(c_double), optional, pointer :: ee(:), ff(:)
|
|
|
|
integer, value :: N
|
|
|
|
! All shall be absent
|
|
if (present(aa) .or. present(bb)) stop 51
|
|
if (present(cc) .or. present(dd)) stop 52
|
|
if (present(ee) .or. present(ff)) stop 53
|
|
|
|
!$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb)
|
|
if (present(aa) .or. present(bb)) stop 54
|
|
!$omp end target data
|
|
|
|
!$omp target data map(to:cc) map(from:dd) use_device_addr(cc,dd)
|
|
if (present(cc) .or. present(dd)) stop 55
|
|
!$omp end target data
|
|
|
|
!$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff)
|
|
if (present(ee) .or. present(ff)) stop 56
|
|
!$omp end target data
|
|
end subroutine test_dummy_opt_callee_1_absent
|
|
|
|
! Save device ptr - and recall pointer
|
|
subroutine test_dummy_opt_call_2()
|
|
integer, parameter :: N = 1000
|
|
|
|
real(c_double), target :: aa(N), bb(N)
|
|
real(c_double), target, allocatable :: cc(:), dd(:)
|
|
real(c_double), pointer :: ee(:), ff(:)
|
|
|
|
type(c_ptr) :: c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr
|
|
real(c_double), pointer :: aptr(:), bptr(:), cptr(:), dptr(:), eptr(:), fptr(:)
|
|
|
|
allocate(cc(N), dd(N), ee(N), ff(N))
|
|
call test_dummy_opt_callee_2(aa, bb, cc, dd, ee, ff, &
|
|
c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, &
|
|
aptr, bptr, cptr, dptr, eptr, fptr, &
|
|
N)
|
|
deallocate(ee, ff)
|
|
end subroutine test_dummy_opt_call_2
|
|
|
|
subroutine test_dummy_opt_callee_2(aa, bb, cc, dd, ee, ff, &
|
|
c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, &
|
|
aptr, bptr, cptr, dptr, eptr, fptr, &
|
|
N)
|
|
! scalars
|
|
real(c_double), optional, target :: aa(:), bb(:)
|
|
real(c_double), optional, target, allocatable :: cc(:), dd(:)
|
|
real(c_double), optional, pointer :: ee(:), ff(:)
|
|
|
|
type(c_ptr) :: c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr
|
|
real(c_double), optional, pointer :: aptr(:), bptr(:), cptr(:), dptr(:), eptr(:), fptr(:)
|
|
|
|
integer, value :: N
|
|
|
|
real(c_double) :: dummy
|
|
|
|
! All shall be present - and pointing to non-NULL
|
|
if (.not.present(aa) .or. .not.present(bb)) stop 57
|
|
if (.not.present(cc) .or. .not.present(dd)) stop 58
|
|
if (.not.present(ee) .or. .not.present(ff)) stop 59
|
|
|
|
if (.not.allocated(cc) .or. .not.allocated(dd)) stop 60
|
|
if (.not.associated(ee) .or. .not.associated(ff)) stop 61
|
|
|
|
aa = 111.0_c_double
|
|
bb = 222.0_c_double
|
|
cc = 333.0_c_double
|
|
dd = 444.0_c_double
|
|
ee = 555.0_c_double
|
|
ff = 666.0_c_double
|
|
|
|
!$omp target data map(to:aa) map(from:bb)
|
|
!$omp target data map(alloc:dummy) use_device_addr(aa,bb)
|
|
if (.not.present(aa) .or. .not.present(bb)) stop 62
|
|
if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) stop 63
|
|
c_aptr = c_loc(aa)
|
|
c_bptr = c_loc(bb)
|
|
aptr => aa
|
|
bptr => bb
|
|
if (.not.c_associated(c_aptr) .or. .not.c_associated(c_bptr)) stop 64
|
|
if (.not.associated(aptr) .or. .not.associated(bptr)) stop 65
|
|
!$omp end target data
|
|
|
|
if (.not.present(aa) .or. .not.present(bb)) stop 66
|
|
if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) stop 67
|
|
if (.not.c_associated(c_aptr) .or. .not.c_associated(c_bptr)) stop 68
|
|
if (.not.associated(aptr) .or. .not.associated(bptr)) stop 69
|
|
|
|
! check c_loc ptr once
|
|
call copy3_array(c_aptr, c_bptr, N)
|
|
!$omp target update from(bb)
|
|
if (any(abs(aa - 111.0_c_double) > 10.0_c_double * epsilon(aa))) stop 70
|
|
if (any(abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa))) stop 71
|
|
|
|
! check c_loc ptr again after target-value modification
|
|
aa = 1111.0_c_double
|
|
!$omp target update to(aa)
|
|
call copy3_array(c_aptr, c_bptr, N)
|
|
!$omp target update from(bb)
|
|
if (any(abs(aa - 1111.0_c_double) > 10.0_c_double * epsilon(aa))) stop 72
|
|
if (any(abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa))) stop 73
|
|
|
|
! check Fortran pointer after target-value modification
|
|
aa = 11111.0_c_double
|
|
!$omp target update to(aa)
|
|
call copy3_array(c_loc(aptr), c_loc(bptr), N)
|
|
!$omp target update from(bb)
|
|
if (any(abs(aa - 11111.0_c_double) > 10.0_c_double * epsilon(aa))) stop 74
|
|
if (any(abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa))) stop 75
|
|
!$omp end target data
|
|
|
|
if (any(abs(aa - 11111.0_c_double) > 10.0_c_double * epsilon(aa))) stop 76
|
|
if (any(abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa))) stop 77
|
|
|
|
!$omp target data map(to:cc) map(from:dd)
|
|
!$omp target data map(alloc:dummy) use_device_addr(cc,dd)
|
|
if (.not.present(cc) .or. .not.present(dd)) stop 78
|
|
if (.not.allocated(cc) .or. .not.allocated(dd)) stop 79
|
|
if (.not.c_associated(c_loc(cc)) .or. .not.c_associated(c_loc(dd))) stop 80
|
|
c_cptr = c_loc(cc)
|
|
c_dptr = c_loc(dd)
|
|
cptr => cc
|
|
dptr => dd
|
|
if (.not.c_associated(c_cptr) .or. .not.c_associated(c_dptr)) stop 81
|
|
if (.not.associated(cptr) .or. .not.associated(dptr)) stop 82
|
|
!$omp end target data
|
|
if (.not.present(cc) .or. .not.present(dd)) stop 83
|
|
if (.not.c_associated(c_loc(cc)) .or. .not.c_associated(c_loc(dd))) stop 84
|
|
if (.not.c_associated(c_cptr) .or. .not.c_associated(c_dptr)) stop 85
|
|
if (.not.associated(cptr) .or. .not.associated(dptr)) stop 86
|
|
|
|
! check c_loc ptr once
|
|
call copy3_array(c_cptr, c_dptr, N)
|
|
!$omp target update from(dd)
|
|
if (any(abs(cc - 333.0_c_double) > 10.0_c_double * epsilon(cc))) stop 87
|
|
if (any(abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc))) stop 88
|
|
|
|
! check c_loc ptr again after target-value modification
|
|
cc = 3333.0_c_double
|
|
!$omp target update to(cc)
|
|
call copy3_array(c_cptr, c_dptr, N)
|
|
!$omp target update from(dd)
|
|
if (any(abs(cc - 3333.0_c_double) > 10.0_c_double * epsilon(cc))) stop 89
|
|
if (any(abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc))) stop 90
|
|
|
|
! check Fortran pointer after target-value modification
|
|
cc = 33333.0_c_double
|
|
!$omp target update to(cc)
|
|
call copy3_array(c_loc(cptr), c_loc(dptr), N)
|
|
!$omp target update from(dd)
|
|
if (any(abs(cc - 33333.0_c_double) > 10.0_c_double * epsilon(cc))) stop 91
|
|
if (any(abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc))) stop 92
|
|
!$omp end target data
|
|
|
|
if (any(abs(cc - 33333.0_c_double) > 10.0_c_double * epsilon(dd))) stop 93
|
|
if (any(abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(dd))) stop 94
|
|
|
|
|
|
!$omp target data map(to:ee) map(from:ff)
|
|
!$omp target data map(alloc:dummy) use_device_addr(ee,ff)
|
|
if (.not.present(ee) .or. .not.present(ff)) stop 95
|
|
if (.not.associated(ee) .or. .not.associated(ff)) stop 96
|
|
if (.not.c_associated(c_loc(ee)) .or. .not.c_associated(c_loc(ff))) stop 97
|
|
c_eptr = c_loc(ee)
|
|
c_fptr = c_loc(ff)
|
|
eptr => ee
|
|
fptr => ff
|
|
if (.not.c_associated(c_eptr) .or. .not.c_associated(c_fptr)) stop 98
|
|
if (.not.associated(eptr) .or. .not.associated(fptr)) stop 99
|
|
!$omp end target data
|
|
if (.not.present(ee) .or. .not.present(ff)) stop 100
|
|
if (.not.associated(ee) .or. .not.associated(ff)) stop 101
|
|
if (.not.c_associated(c_loc(ee)) .or. .not.c_associated(c_loc(ff))) stop 102
|
|
if (.not.c_associated(c_eptr) .or. .not.c_associated(c_fptr)) stop 103
|
|
if (.not.associated(eptr) .or. .not.associated(fptr)) stop 104
|
|
|
|
! check c_loc ptr once
|
|
call copy3_array(c_eptr, c_fptr, N)
|
|
!$omp target update from(ff)
|
|
if (any(abs(ee - 555.0_c_double) > 10.0_c_double * epsilon(ee))) stop 105
|
|
if (any(abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee))) stop 106
|
|
|
|
! check c_loc ptr again after target-value modification
|
|
ee = 5555.0_c_double
|
|
!$omp target update to(ee)
|
|
call copy3_array(c_eptr, c_fptr, N)
|
|
!$omp target update from(ff)
|
|
if (any(abs(ee - 5555.0_c_double) > 10.0_c_double * epsilon(ee))) stop 107
|
|
if (any(abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee))) stop 108
|
|
|
|
! check Fortran pointer after target-value modification
|
|
ee = 55555.0_c_double
|
|
!$omp target update to(ee)
|
|
call copy3_array(c_loc(eptr), c_loc(fptr), N)
|
|
!$omp target update from(ff)
|
|
if (any(abs(ee - 55555.0_c_double) > 10.0_c_double * epsilon(ee))) stop 109
|
|
if (any(abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ff))) stop 110
|
|
!$omp end target data
|
|
|
|
if (any(abs(ee - 55555.0_c_double) > 10.0_c_double * epsilon(ee))) stop 111
|
|
if (any(abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee))) stop 112
|
|
end subroutine test_dummy_opt_callee_2
|
|
end module test_dummies_opt
|
|
|
|
|
|
|
|
! Test nullptr
|
|
module test_nullptr
|
|
use iso_c_binding
|
|
implicit none (type, external)
|
|
private
|
|
public :: test_nullptr_1
|
|
contains
|
|
subroutine test_nullptr_1()
|
|
real(c_double), pointer :: aa(:), bb(:)
|
|
real(c_double), pointer :: ee(:), ff(:)
|
|
|
|
real(c_double), allocatable, target :: gg(:), hh(:)
|
|
|
|
type(c_ptr) :: c_aptr, c_bptr, c_eptr, c_fptr, c_gptr, c_hptr
|
|
real(c_double), pointer :: aptr(:), bptr(:), eptr(:), fptr(:), gptr(:), hptr(:)
|
|
|
|
aa => null()
|
|
bb => null()
|
|
ee => null()
|
|
ff => null()
|
|
|
|
if (associated(aa) .or. associated(bb)) stop 113
|
|
!$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb)
|
|
if (c_associated(c_loc(aa)) .or. c_associated(c_loc(bb))) stop 114
|
|
c_aptr = c_loc(aa)
|
|
c_bptr = c_loc(bb)
|
|
aptr => aa
|
|
bptr => bb
|
|
if (c_associated(c_aptr) .or. c_associated(c_bptr)) stop 115
|
|
if (associated(aptr) .or. associated(bptr, bb)) stop 116
|
|
if (associated(aa) .or. associated(bb)) stop 117
|
|
!$omp end target data
|
|
if (c_associated(c_aptr) .or. c_associated(c_bptr)) stop 118
|
|
if (associated(aptr) .or. associated(bptr, bb)) stop 119
|
|
if (associated(aa) .or. associated(bb)) stop 120
|
|
|
|
if (allocated(gg)) stop 121
|
|
!$omp target data map(tofrom:gg) use_device_addr(gg)
|
|
if (c_associated(c_loc(gg))) stop 122
|
|
c_gptr = c_loc(gg)
|
|
gptr => gg
|
|
if (c_associated(c_gptr)) stop 123
|
|
if (associated(gptr)) stop 124
|
|
if (allocated(gg)) stop 125
|
|
!$omp end target data
|
|
if (c_associated(c_gptr)) stop 126
|
|
if (associated(gptr)) stop 127
|
|
if (allocated(gg)) stop 128
|
|
|
|
call test_dummy_opt_nullptr_callee_1(ee, ff, hh, c_eptr, c_fptr, c_hptr, eptr, fptr, hptr)
|
|
end subroutine test_nullptr_1
|
|
|
|
subroutine test_dummy_opt_nullptr_callee_1(ee, ff, hh, c_eptr, c_fptr, c_hptr, eptr, fptr, hptr)
|
|
! scalars
|
|
real(c_double), optional, pointer :: ee(:), ff(:)
|
|
real(c_double), optional, allocatable, target :: hh(:)
|
|
|
|
type(c_ptr), optional :: c_eptr, c_fptr, c_hptr
|
|
real(c_double), optional, pointer :: eptr(:), fptr(:), hptr(:)
|
|
|
|
if (.not.present(ee) .or. .not.present(ff)) stop 129
|
|
if (associated(ee) .or. associated(ff)) stop 130
|
|
|
|
!$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff)
|
|
if (.not.present(ee) .or. .not.present(ff)) stop 131
|
|
if (associated(ee) .or. associated(ff)) stop 132
|
|
if (c_associated(c_loc(ee)) .or. c_associated(c_loc(ff))) stop 133
|
|
c_eptr = c_loc(ee)
|
|
c_fptr = c_loc(ff)
|
|
eptr => ee
|
|
fptr => ff
|
|
if (c_associated(c_eptr) .or. c_associated(c_fptr)) stop 134
|
|
if (associated(eptr) .or. associated(fptr)) stop 135
|
|
!$omp end target data
|
|
|
|
if (c_associated(c_eptr) .or. c_associated(c_fptr)) stop 136
|
|
if (associated(eptr) .or. associated(fptr)) stop 137
|
|
|
|
if (allocated(hh)) stop 138
|
|
!$omp target data map(tofrom:hh) use_device_addr(hh)
|
|
if (c_associated(c_loc(hh))) stop 139
|
|
c_hptr = c_loc(hh)
|
|
hptr => hh
|
|
if (c_associated(c_hptr)) stop 140
|
|
if (associated(hptr)) stop 141
|
|
if (allocated(hh)) stop 142
|
|
!$omp end target data
|
|
if (c_associated(c_hptr)) stop 143
|
|
if (associated(hptr)) stop 144
|
|
if (allocated(hh)) stop 145
|
|
end subroutine test_dummy_opt_nullptr_callee_1
|
|
end module test_nullptr
|
|
|
|
|
|
|
|
! Test local variables
|
|
module tests
|
|
use iso_c_binding
|
|
use target_procs
|
|
implicit none (type, external)
|
|
private
|
|
public :: test_main_1, test_main_2
|
|
contains
|
|
! map + use_device_addr + c_loc
|
|
subroutine test_main_1()
|
|
integer, parameter :: N = 1000
|
|
|
|
real(c_double), target, allocatable :: cc(:), dd(:)
|
|
real(c_double), pointer :: ee(:), ff(:)
|
|
|
|
allocate(cc(N), dd(N), ee(N), ff(N))
|
|
|
|
cc = 33.0_c_double
|
|
dd = 44.0_c_double
|
|
ee = 55.0_c_double
|
|
ff = 66.0_c_double
|
|
|
|
!$omp target data map(to:cc) map(from:dd) use_device_addr(cc,dd)
|
|
call copy3_array(c_loc(cc), c_loc(dd), N)
|
|
!$omp end target data
|
|
if (any(abs(cc - 33.0_c_double) > 10.0_c_double * epsilon(cc))) stop 146
|
|
if (any(abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc))) stop 147
|
|
|
|
!$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff)
|
|
call copy3_array(c_loc(ee), c_loc(ff), N)
|
|
!$omp end target data
|
|
if (any(abs(ee - 55.0_c_double) > 10.0_c_double * epsilon(ee))) stop 148
|
|
if (any(abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee))) stop 149
|
|
|
|
deallocate(ee, ff) ! pointers, only
|
|
end subroutine test_main_1
|
|
|
|
! Save device ptr - and recall pointer
|
|
subroutine test_main_2
|
|
integer, parameter :: N = 1000
|
|
|
|
real(c_double), target, allocatable :: cc(:), dd(:)
|
|
real(c_double), pointer :: ee(:), ff(:)
|
|
|
|
real(c_double) :: dummy
|
|
type(c_ptr) :: c_cptr, c_dptr, c_eptr, c_fptr
|
|
real(c_double), pointer :: cptr(:), dptr(:), eptr(:), fptr(:)
|
|
|
|
allocate(cc(N), dd(N), ee(N), ff(N))
|
|
|
|
cc = 333.0_c_double
|
|
dd = 444.0_c_double
|
|
ee = 555.0_c_double
|
|
ff = 666.0_c_double
|
|
|
|
!$omp target data map(to:cc) map(from:dd)
|
|
!$omp target data map(alloc:dummy) use_device_addr(cc,dd)
|
|
c_cptr = c_loc(cc)
|
|
c_dptr = c_loc(dd)
|
|
cptr => cc
|
|
dptr => dd
|
|
!$omp end target data
|
|
|
|
! check c_loc ptr once
|
|
call copy3_array(c_cptr, c_dptr, N)
|
|
!$omp target update from(dd)
|
|
if (any(abs(cc - 333.0_c_double) > 10.0_c_double * epsilon(cc))) stop 150
|
|
if (any(abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc))) stop 151
|
|
|
|
! check c_loc ptr again after target-value modification
|
|
cc = 3333.0_c_double
|
|
!$omp target update to(cc)
|
|
call copy3_array(c_cptr, c_dptr, N)
|
|
!$omp target update from(dd)
|
|
if (any(abs(cc - 3333.0_c_double) > 10.0_c_double * epsilon(cc))) stop 152
|
|
if (any(abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc))) stop 153
|
|
|
|
! check Fortran pointer after target-value modification
|
|
cc = 33333.0_c_double
|
|
!$omp target update to(cc)
|
|
call copy3_array(c_loc(cptr), c_loc(dptr), N)
|
|
!$omp target update from(dd)
|
|
if (any(abs(cc - 33333.0_c_double) > 10.0_c_double * epsilon(cc))) stop 154
|
|
if (any(abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc))) stop 155
|
|
!$omp end target data
|
|
|
|
if (any(abs(cc - 33333.0_c_double) > 10.0_c_double * epsilon(dd))) stop 156
|
|
if (any(abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(dd))) stop 157
|
|
|
|
|
|
!$omp target data map(to:ee) map(from:ff)
|
|
!$omp target data map(alloc:dummy) use_device_addr(ee,ff)
|
|
c_eptr = c_loc(ee)
|
|
c_fptr = c_loc(ff)
|
|
eptr => ee
|
|
fptr => ff
|
|
!$omp end target data
|
|
|
|
! check c_loc ptr once
|
|
call copy3_array(c_eptr, c_fptr, N)
|
|
!$omp target update from(ff)
|
|
if (any(abs(ee - 555.0_c_double) > 10.0_c_double * epsilon(ee))) stop 158
|
|
if (any(abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee))) stop 159
|
|
|
|
! check c_loc ptr again after target-value modification
|
|
ee = 5555.0_c_double
|
|
!$omp target update to(ee)
|
|
call copy3_array(c_eptr, c_fptr, N)
|
|
!$omp target update from(ff)
|
|
if (any(abs(ee - 5555.0_c_double) > 10.0_c_double * epsilon(ee))) stop 160
|
|
if (any(abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee))) stop 161
|
|
|
|
! check Fortran pointer after target-value modification
|
|
ee = 55555.0_c_double
|
|
!$omp target update to(ee)
|
|
call copy3_array(c_loc(eptr), c_loc(fptr), N)
|
|
!$omp target update from(ff)
|
|
if (any(abs(ee - 55555.0_c_double) > 10.0_c_double * epsilon(ee))) stop 162
|
|
if (any(abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ff))) stop 163
|
|
!$omp end target data
|
|
|
|
if (any(abs(ee - 55555.0_c_double) > 10.0_c_double * epsilon(ee))) stop 164
|
|
if (any(abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee))) stop 165
|
|
|
|
deallocate(ee, ff)
|
|
end subroutine test_main_2
|
|
end module tests
|
|
|
|
|
|
program omp_device_addr
|
|
use tests
|
|
use test_dummies
|
|
use test_dummies_opt
|
|
use test_nullptr
|
|
implicit none (type, external)
|
|
|
|
call test_main_1()
|
|
call test_main_2()
|
|
|
|
call test_dummy_call_1()
|
|
call test_dummy_call_2()
|
|
|
|
call test_dummy_opt_call_1()
|
|
call test_dummy_opt_call_2()
|
|
|
|
call test_nullptr_1()
|
|
end program omp_device_addr
|