[OpenMP,Fortran] Fix several OpenMP use_device_addr/map/update errors found by a length test case

Message ID	3384177e-e8e1-a634-e544-dc38c7593d2a@codesourcery.com
State	New
Headers	show Return-Path: <gcc-patches-return-510432-incoming=patchwork.ozlabs.org@gcc.gnu.org> DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :subject:from:to:references:message-id:date:mime-version :in-reply-to:content-type; q=dns; s=default; b=XwBTubKiT93WbYvf7 6+EsY/7aCVz6MiQ+3/nO+Te2BoHlICFe1IfUJisIITM/jBCax3nTtJ2V9NduIabr jNR3Vtni3Ar5ux2dW42cD87UHKuihbKVtj8pjkE7Jm76ZHuBh7F6V9KcHcIGouJ0 AVfb5jMiuR8n//wQdYqf2Igvqo= Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk Sender: gcc-patches-owner@gcc.gnu.org IronPort-SDR: +AMmeikCBrxo7IEtUVr7peq2vmjZegOQjCF800rDYcBZ1FoQnsx70Po+Vv/J7U2e/1MPpn4noS lyoAAzoW+BYKFvFz6JI2NJAiGllNPRL5zhVtxNnlUzN7rLSRyQaFM+PCgKHxvpy41+vMwuQgiU h4RHNoqs2oSCRv5MWfxN1qvBKjN/+ywteoRoodM3IwVb8Ay39s1cO8ZFq8+9ZLO6Y7cDU1dbQr 2DqJCIiYQn1ITPWUyUiUlB7E9v6/PvfLqb+AVoFInfNLjB5aKvkVn92qjjmMVNnXTbG+muKGUU CuA= IronPort-SDR: Tfx/Rq/yKvGkfK/nTz9GjoAwFgxDykWq8eIvLEVpkZlcTE8DJyvIQJnOhBzShcfx/+G2Q3Cpl4 0aeDKJ22BTrZf1YAgqrQpj8vxGIwPRgDlFWKBZegYA759nr5B7XpCrfh8bQRXm87vtinNEcfzq +WXyOvjjoqS/doLHLZ5W6q0e1Ewzc8uNeUSLavjSTyr6Ej0ZDKUm9voerqCLOCLhaw6L0LYwiG vP9SxhEFzteVMjET/8VM7DPxVdOTvctYlOPpxAmxBrcxyT2BmkhGAF9Kybu4PabH7OdPbNBpx7 pdQ= Subject: [patch][OpenMP, Fortran] Fix several OpenMP use_device_addr/map/update errors found by a length test case From: Tobias Burnus <tobias@codesourcery.com> To: gcc-patches <gcc-patches@gcc.gnu.org>, fortran <fortran@gcc.gnu.org>, Jakub Jelinek <jakub@redhat.com> References: <4a155db7-d761-824a-519e-f65463478325@codesourcery.com> Message-ID: <3384177e-e8e1-a634-e544-dc38c7593d2a@codesourcery.com> Date: Tue, 8 Oct 2019 01:11:53 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:68.0) Gecko/20100101 Thunderbird/68.1.0 MIME-Version: 1.0 In-Reply-To: <4a155db7-d761-824a-519e-f65463478325@codesourcery.com> Content-Type: multipart/mixed; boundary="------------80DDB3E38DC166F444DC8709"
Series	[OpenMP,Fortran] Fix several OpenMP use_device_addr/map/update errors found by a length test case \| expand [OpenMP,Fortran] Fix several OpenMP use_device_addr/map/update errors found by a length test case

gcc/fortran/ * f95-lang.c (LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR): Re-define to gfc_omp_is_allocatable_or_ptr. * trans-decl.c (create_function_arglist): Set GFC_DECL_OPTIONAL_ARGUMENT only if not passed by value. * trans-openmp.c (gfc_omp_is_allocatable_or_ptr): New. (gfc_trans_omp_clauses): Actually pass use_device_addr on to the middle end; for MAP, handle (present) optional arguments; for target update, handle allocatable/pointer scalars. * trans.h (gfc_omp_is_allocatable_or_ptr): Declare. gcc/ * langhooks-def.h (LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR): Define. (LANG_HOOKS_DECLS): Add it. * langhooks.h (lang_hooks_for_decls): Add omp_is_allocatable_or_ptr; update comment for omp_is_optional_argument. * omp-general.c (omp_is_allocatable_or_ptr): New. * omp-general.h (omp_is_allocatable_or_ptr): Declare. * omp-low.c (scan_sharing_clauses, lower_omp_target): Handle Fortran's optional arguments and allocatable/pointer scalars with use_device_addr. libgomp/ * testsuite/libgomp.fortran/use_device_addr-1.f90: New. * testsuite/libgomp.fortran/use_device_addr-2.f90: New. gcc/fortran/f95-lang.c | 2 + gcc/fortran/trans-decl.c | 3 +- gcc/fortran/trans-openmp.c | 35 +- gcc/fortran/trans.h | 1 + gcc/langhooks-def.h | 2 + gcc/langhooks.h | 9 +- gcc/omp-general.c | 8 + gcc/omp-general.h | 1 + gcc/omp-low.c | 38 +- .../libgomp.fortran/use_device_addr-1.f90 | 1202 ++++++++++++++++++++ .../libgomp.fortran/use_device_addr-2.f90 | 1202 ++++++++++++++++++++ 11 files changed, 2489 insertions(+), 14 deletions(-) diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c index 2467cd968af..0f72ab9e3b4 100644 --- a/gcc/fortran/f95-lang.c +++ b/gcc/fortran/f95-lang.c @@ -113,6 +113,7 @@ static const struct attribute_spec gfc_attribute_table[] = #undef LANG_HOOKS_TYPE_FOR_MODE #undef LANG_HOOKS_TYPE_FOR_SIZE #undef LANG_HOOKS_INIT_TS +#undef LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR #undef LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT #undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE #undef LANG_HOOKS_OMP_PREDETERMINED_SHARING @@ -146,6 +147,7 @@ static const struct attribute_spec gfc_attribute_table[] = #define LANG_HOOKS_TYPE_FOR_MODE gfc_type_for_mode #define LANG_HOOKS_TYPE_FOR_SIZE gfc_type_for_size #define LANG_HOOKS_INIT_TS gfc_init_ts +#define LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR gfc_omp_is_allocatable_or_ptr #define LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT gfc_omp_is_optional_argument #define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE gfc_omp_privatize_by_reference #define LANG_HOOKS_OMP_PREDETERMINED_SHARING gfc_omp_predetermined_sharing diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index b701f493440..698d90a4d42 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2691,8 +2691,9 @@ create_function_arglist (gfc_symbol * sym) && (!f->sym->attr.proc_pointer && f->sym->attr.flavor != FL_PROCEDURE)) DECL_BY_REFERENCE (parm) = 1; - if (f->sym->attr.optional) + if (f->sym->attr.optional && !f->sym->attr.value) { + // With value, the argument is passed as is gfc_allocate_lang_decl (parm); GFC_DECL_OPTIONAL_ARGUMENT (parm) = 1; } diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index f83bab4850e..dad11a24430 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -47,7 +47,21 @@ along with GCC; see the file COPYING3. If not see int ompws_flags; -/* True if OpenMP should treat this DECL as an optional argument. */ +/* True if OpenMP should regard this DECL as being a scalar which has Fortran's + allocatable or pointer attribute. */ + +bool +gfc_omp_is_allocatable_or_ptr (const_tree decl) +{ + return (DECL_P (decl) + && (GFC_DECL_GET_SCALAR_POINTER (decl) + || GFC_DECL_GET_SCALAR_ALLOCATABLE (decl))); +} + +/* True if OpenMP should treat this DECL as an optional argument; note: for + arguments with VALUE attribute, the DECL is identical to nonoptional + arguments; hence, we return false here. To check whether the variable is + present, use the DECL which is passed as hidden argument. */ bool gfc_omp_is_optional_argument (const_tree decl) @@ -1887,6 +1901,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, case OMP_LIST_USE_DEVICE_PTR: clause_code = OMP_CLAUSE_USE_DEVICE_PTR; goto add_clause; + case OMP_LIST_USE_DEVICE_ADDR: + clause_code = OMP_CLAUSE_USE_DEVICE_ADDR; + goto add_clause; case OMP_LIST_IS_DEVICE_PTR: clause_code = OMP_CLAUSE_IS_DEVICE_PTR; goto add_clause; @@ -2170,7 +2187,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, OMP_CLAUSE_DECL (node4) = decl; OMP_CLAUSE_SIZE (node4) = size_int (0); decl = build_fold_indirect_ref (decl); - if (TREE_CODE (TREE_TYPE (orig_decl)) == REFERENCE_TYPE + if ((TREE_CODE (TREE_TYPE (orig_decl)) == REFERENCE_TYPE + || gfc_omp_is_optional_argument (orig_decl)) && (GFC_DECL_GET_SCALAR_POINTER (orig_decl) || GFC_DECL_GET_SCALAR_ALLOCATABLE (orig_decl))) { @@ -2414,7 +2432,11 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, { tree decl = gfc_trans_omp_variable (n->sym, false); if (gfc_omp_privatize_by_reference (decl)) - decl = build_fold_indirect_ref (decl); + { + if (gfc_omp_is_allocatable_or_ptr (decl)) + decl = build_fold_indirect_ref (decl); + decl = build_fold_indirect_ref (decl); + } else if (DECL_P (decl)) TREE_ADDRESSABLE (decl) = 1; if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))) @@ -2436,7 +2458,12 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, OMP_CLAUSE_SIZE (node), elemsz); } else - OMP_CLAUSE_DECL (node) = decl; + { + OMP_CLAUSE_DECL (node) = decl; + if (gfc_omp_is_allocatable_or_ptr (decl)) + OMP_CLAUSE_SIZE (node) + = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (decl))); + } } else { diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 405e88dd1c4..e96b22acc68 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -786,6 +786,7 @@ struct array_descr_info; bool gfc_get_array_descr_info (const_tree, struct array_descr_info *); /* In trans-openmp.c */ +bool gfc_omp_is_allocatable_or_ptr (const_tree); bool gfc_omp_is_optional_argument (const_tree); bool gfc_omp_privatize_by_reference (const_tree); enum omp_clause_default_kind gfc_omp_predetermined_sharing (tree); diff --git a/gcc/langhooks-def.h b/gcc/langhooks-def.h index 55d5fe01495..c5dc83d1cc8 100644 --- a/gcc/langhooks-def.h +++ b/gcc/langhooks-def.h @@ -236,6 +236,7 @@ extern tree lhd_unit_size_without_reusable_padding (tree); #define LANG_HOOKS_WARN_UNUSED_GLOBAL_DECL lhd_warn_unused_global_decl #define LANG_HOOKS_POST_COMPILATION_PARSING_CLEANUPS NULL #define LANG_HOOKS_DECL_OK_FOR_SIBCALL lhd_decl_ok_for_sibcall +#define LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR hook_bool_const_tree_false #define LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT hook_bool_const_tree_false #define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE hook_bool_const_tree_false #define LANG_HOOKS_OMP_PREDETERMINED_SHARING lhd_omp_predetermined_sharing @@ -262,6 +263,7 @@ extern tree lhd_unit_size_without_reusable_padding (tree); LANG_HOOKS_WARN_UNUSED_GLOBAL_DECL, \ LANG_HOOKS_POST_COMPILATION_PARSING_CLEANUPS, \ LANG_HOOKS_DECL_OK_FOR_SIBCALL, \ + LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR, \ LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT, \ LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE, \ LANG_HOOKS_OMP_PREDETERMINED_SHARING, \ diff --git a/gcc/langhooks.h b/gcc/langhooks.h index 9d2714a5b1d..97e3186a41d 100644 --- a/gcc/langhooks.h +++ b/gcc/langhooks.h @@ -222,7 +222,14 @@ struct lang_hooks_for_decls /* True if this decl may be called via a sibcall. */ bool (*ok_for_sibcall) (const_tree); - /* True if OpenMP should treat DECL as a Fortran optional argument. */ + /* True if OpenMP should regard this DECL as being a scalar which has Fortran's + allocatable or pointer attribute. */ + bool (*omp_is_allocatable_or_ptr) (const_tree); + + /* True if OpenMP should treat DECL as a Fortran optional argument; note: for + arguments with VALUE attribute, the DECL is identical to nonoptional + arguments; hence, we return false here. To check whether the variable is + present, use the DECL which is passed as hidden argument. */ bool (*omp_is_optional_argument) (const_tree); /* True if OpenMP should privatize what this DECL points to rather diff --git a/gcc/omp-general.c b/gcc/omp-general.c index 5ef6e251698..1a78a70bd57 100644 --- a/gcc/omp-general.c +++ b/gcc/omp-general.c @@ -48,6 +48,14 @@ omp_find_clause (tree clauses, enum omp_clause_code kind) return NULL_TREE; } +/* True if OpenMP should regard this DECL as being a scalar which has Fortran's + allocatable or pointer attribute. */ +bool +omp_is_allocatable_or_ptr (tree decl) +{ + return lang_hooks.decls.omp_is_allocatable_or_ptr (decl); +} + /* Return true if DECL is a Fortran optional argument. */ bool diff --git a/gcc/omp-general.h b/gcc/omp-general.h index bbaa7b11707..7cd1d216fc0 100644 --- a/gcc/omp-general.h +++ b/gcc/omp-general.h @@ -73,6 +73,7 @@ struct omp_for_data #define OACC_FN_ATTRIB "oacc function" extern tree omp_find_clause (tree clauses, enum omp_clause_code kind); +extern bool omp_is_allocatable_or_ptr (tree decl); extern bool omp_is_optional_argument (tree decl); extern bool omp_is_reference (tree decl); extern void omp_adjust_for_condition (location_t loc, enum tree_code *cond_code, diff --git a/gcc/omp-low.c b/gcc/omp-low.c index ca7dfdb83a1..a635d736154 100644 --- a/gcc/omp-low.c +++ b/gcc/omp-low.c @@ -1241,7 +1241,8 @@ scan_sharing_clauses (tree clauses, omp_context *ctx) case OMP_CLAUSE_USE_DEVICE_ADDR: decl = OMP_CLAUSE_DECL (c); if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR - && !omp_is_reference (decl)) + && !omp_is_reference (decl) + && !omp_is_allocatable_or_ptr (decl)) || TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE) install_var_field (decl, true, 11, ctx); else @@ -11483,7 +11484,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) DECL_HAS_VALUE_EXPR_P (new_var) = 1; } else if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR - && !omp_is_reference (var)) + && !omp_is_reference (var) + && !omp_is_allocatable_or_ptr (var)) || TREE_CODE (TREE_TYPE (var)) == ARRAY_TYPE) { tree new_var = lookup_decl (var, ctx); @@ -11678,7 +11680,18 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) } else { - var = build_fold_addr_expr (var); + // While MAP is handled explicitly by the FE, + // for 'target update', only the identified is passed. + if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FROM + || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_TO) + && (omp_is_allocatable_or_ptr (var) + && omp_is_optional_argument (var))) + var = build_fold_indirect_ref (var); + else if ((OMP_CLAUSE_CODE (c) != OMP_CLAUSE_FROM + && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_TO) + || (!omp_is_allocatable_or_ptr (var) + && !omp_is_optional_argument (var))) + var = build_fold_addr_expr (var); gimplify_assign (x, var, &ilist); } } @@ -11865,16 +11878,22 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) } type = TREE_TYPE (ovar); if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR - && !omp_is_reference (ovar)) + && !omp_is_reference (ovar) + && !omp_is_allocatable_or_ptr (ovar)) || TREE_CODE (type) == ARRAY_TYPE) var = build_fold_addr_expr (var); else { - if (omp_is_reference (ovar) || omp_is_optional_argument (ovar)) + if (omp_is_reference (ovar) + || omp_is_optional_argument (ovar) + || omp_is_allocatable_or_ptr (ovar)) { type = TREE_TYPE (type); if (TREE_CODE (type) != ARRAY_TYPE - && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_USE_DEVICE_ADDR) + && ((OMP_CLAUSE_CODE (c) != OMP_CLAUSE_USE_DEVICE_ADDR + && !omp_is_allocatable_or_ptr (ovar)) + || (omp_is_reference (ovar) + && omp_is_allocatable_or_ptr (ovar)))) var = build_simple_mem_ref (var); var = fold_convert (TREE_TYPE (x), var); } @@ -12045,7 +12064,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) gimple_build_assign (new_var, x)); } else if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR - && !omp_is_reference (var)) + && !omp_is_reference (var) + && !omp_is_allocatable_or_ptr (var)) || TREE_CODE (TREE_TYPE (var)) == ARRAY_TYPE) { tree new_var = lookup_decl (var, ctx); @@ -12065,7 +12085,9 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) { type = TREE_TYPE (type); if (TREE_CODE (type) != ARRAY_TYPE - && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_USE_DEVICE_ADDR) + && (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_USE_DEVICE_ADDR + || (omp_is_reference (var) + && omp_is_allocatable_or_ptr (var)))) { tree v = create_tmp_var_raw (type, get_name (var)); gimple_add_tmp_var (v); diff --git a/libgomp/testsuite/libgomp.fortran/use_device_addr-1.f90 b/libgomp/testsuite/libgomp.fortran/use_device_addr-1.f90 new file mode 100644 index 00000000000..852fad6d2f5 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/use_device_addr-1.f90 @@ -0,0 +1,1202 @@ +! Comprehensive run-time test for use_device_addr +! +! Differs from use_device_addr-2.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: +! - arrays with array descriptor +! - polymorphic variables +! - absent optional arguments +! +module target_procs + use iso_c_binding + implicit none + private + public :: copy3_array, copy3_scalar +contains + subroutine copy3_array_int(from_intptr, to_intptr, N) + !$omp declare target + !type(c_ptr), value :: from, to + integer(c_intptr_t), value :: from_intptr, to_intptr ! VALUE issue, cf. copy3_array + type(c_ptr) :: from, to + integer, value :: N + + real(c_double), pointer :: from_ptr(:) + real(c_double), pointer :: to_ptr(:) + integer :: i + + from = transfer(from_intptr, mold=from) + to = transfer(to_intptr, mold=to) + call c_f_pointer(from, from_ptr, shape=[N]) + call c_f_pointer(to, to_ptr, shape=[N]) + + !$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_scalar_int(from_intptr, to_intptr) + !$omp declare target + !type(c_ptr), value :: from, to + integer(c_intptr_t), value :: from_intptr, to_intptr ! VALUE issue, cf. copy3_array + type(c_ptr) :: from, to + + real(c_double), pointer :: from_ptr + real(c_double), pointer :: to_ptr + + from = transfer(from_intptr, mold=from) + to = transfer(to_intptr, mold=to) + call c_f_pointer(from, from_ptr) + call c_f_pointer(to, to_ptr) + + to_ptr = 3 * from_ptr + end subroutine copy3_scalar_int + + + subroutine copy3_array(from, to, N) + type(c_ptr) :: from, to + integer, value :: N +! [OpenMP issue:] Would like to use the following but it is not permitted due to VALUE. +! !$omp target is_device_ptr(from, to) +! call copy3_array_int(from, to, N) +! !$omp end target +! Hence: + integer(c_intptr_t) :: from_intptr, to_intptr + + from_intptr = transfer(from, mold=from_intptr) + to_intptr = transfer(to, mold=to_intptr) + + !$omp target + call copy3_array_int(from_intptr, to_intptr, N) + !$omp end target + end subroutine copy3_array + + subroutine copy3_scalar(from, to) + type(c_ptr), value :: from, to ! VALUE issue, cf. copy3_array above + integer(c_intptr_t) :: from_intptr, to_intptr + + from_intptr = transfer(from, mold=from_intptr) + to_intptr = transfer(to, mold=to_intptr) + + !$omp target + call copy3_scalar_int(from_intptr, to_intptr) + !$omp end target + end subroutine copy3_scalar +end module target_procs + + + +! Test local dummy arguments (w/o optional) +module test_dummies + use iso_c_binding + use target_procs + implicit none + private + public :: test_dummy_call_1, test_dummy_call_2 +contains + subroutine test_dummy_call_1() + integer, parameter :: N = 1000 + + ! scalars + real(c_double), target :: aa, bb + real(c_double), target, allocatable :: cc, dd + real(c_double), pointer :: ee, ff + + ! non-descriptor arrays + real(c_double), target :: gg(N), hh(N) + + allocate(cc, dd, ee, ff) + + 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 + gg = 77.0_c_double + hh = 88.0_c_double + + call test_dummy_callee_1(aa, bb, cc, dd, ee, ff, gg, hh, N) + deallocate(ee, ff) ! pointers, only + end subroutine test_dummy_call_1 + + subroutine test_dummy_callee_1(aa, bb, cc, dd, ee, ff, gg, hh, N) + ! scalars + real(c_double), target :: aa, bb + real(c_double), target, allocatable :: cc, dd + real(c_double), pointer :: ee, ff + + ! non-descriptor arrays + real(c_double), target :: gg(N), hh(N) + integer, value :: N + + !$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb) + call copy3_scalar(c_loc(aa), c_loc(bb)) + !$omp end target data + if (abs(aa - 11.0_c_double) > 10.0_c_double * epsilon(aa)) call abort() + if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort() + + !$omp target data map(to:cc) map(from:dd) use_device_addr(cc,dd) + call copy3_scalar(c_loc(cc), c_loc(dd)) + !$omp end target data + if (abs(cc - 33.0_c_double) > 10.0_c_double * epsilon(cc)) call abort() + if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc)) call abort() + + !$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff) + call copy3_scalar(c_loc(ee), c_loc(ff)) + !$omp end target data + if (abs(ee - 55.0_c_double) > 10.0_c_double * epsilon(ee)) call abort() + if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee)) call abort() + + + !$omp target data map(to:gg) map(from:hh) use_device_addr(gg,hh) + call copy3_array(c_loc(gg), c_loc(hh), N) + !$omp end target data + if (any(abs(gg - 77.0_c_double) > 10.0_c_double * epsilon(gg))) call abort() + if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(gg))) call abort() + end subroutine test_dummy_callee_1 + + ! Save device ptr - and recall pointer + subroutine test_dummy_call_2() + integer, parameter :: N = 1000 + + ! scalars + real(c_double), target :: aa, bb + real(c_double), target, allocatable :: cc, dd + real(c_double), pointer :: ee, ff + + ! non-descriptor arrays + real(c_double), target :: gg(N), hh(N) + + type(c_ptr) :: c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, c_gptr, c_hptr + real(c_double), pointer :: aptr, bptr, cptr, dptr, eptr, fptr + real(c_double), pointer :: gptr(:), hptr(:) + + allocate(cc, dd, ee, ff) + call test_dummy_callee_2(aa, bb, cc, dd, ee, ff, gg, hh, & + c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, c_gptr, c_hptr, & + aptr, bptr, cptr, dptr, eptr, fptr, gptr, hptr, & + N) + deallocate(ee, ff) + end subroutine test_dummy_call_2 + + subroutine test_dummy_callee_2(aa, bb, cc, dd, ee, ff, gg, hh, & + c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, c_gptr, c_hptr, & + aptr, bptr, cptr, dptr, eptr, fptr, gptr, hptr, & + N) + ! scalars + real(c_double), target :: aa, bb + real(c_double), target, allocatable :: cc, dd + real(c_double), pointer :: ee, ff + + ! non-descriptor arrays + real(c_double), target :: gg(N), hh(N) + + type(c_ptr) :: c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, c_gptr, c_hptr + real(c_double), pointer :: aptr, bptr, cptr, dptr, eptr, fptr + real(c_double), pointer :: gptr(:), hptr(:) + + 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 + gg = 777.0_c_double + hh = 888.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_scalar(c_aptr, c_bptr) + !$omp target update from(bb) + if (abs(aa - 111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort() + if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort() + + ! check c_loc ptr again after target-value modification + aa = 1111.0_c_double + !$omp target update to(aa) + call copy3_scalar(c_aptr, c_bptr) + !$omp target update from(bb) + if (abs(aa - 1111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort() + if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort() + + ! check Fortran pointer after target-value modification + aa = 11111.0_c_double + !$omp target update to(aa) + call copy3_scalar(c_loc(aptr), c_loc(bptr)) + !$omp target update from(bb) + if (abs(aa - 11111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort() + if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort() + !$omp end target data + + if (abs(aa - 11111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort() + if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort() + + + !$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_scalar(c_cptr, c_dptr) + !$omp target update from(dd) + if (abs(cc - 333.0_c_double) > 10.0_c_double * epsilon(cc)) call abort() + if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc)) call abort() + + ! check c_loc ptr again after target-value modification + cc = 3333.0_c_double + !$omp target update to(cc) + call copy3_scalar(c_cptr, c_dptr) + !$omp target update from(dd) + if (abs(cc - 3333.0_c_double) > 10.0_c_double * epsilon(cc)) call abort() + if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc)) call abort() + + ! check Fortran pointer after target-value modification + cc = 33333.0_c_double + !$omp target update to(cc) + call copy3_scalar(c_loc(cptr), c_loc(dptr)) + !$omp target update from(dd) + if (abs(cc - 33333.0_c_double) > 10.0_c_double * epsilon(cc)) call abort() + if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc)) call abort() + !$omp end target data + + if (abs(cc - 33333.0_c_double) > 10.0_c_double * epsilon(dd)) call abort() + if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(dd)) call abort() + + + !$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_scalar(c_eptr, c_fptr) + !$omp target update from(ff) + if (abs(ee - 555.0_c_double) > 10.0_c_double * epsilon(ee)) call abort() + if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee)) call abort() + + ! check c_loc ptr again after target-value modification + ee = 5555.0_c_double + !$omp target update to(ee) + call copy3_scalar(c_eptr, c_fptr) + !$omp target update from(ff) + if (abs(ee - 5555.0_c_double) > 10.0_c_double * epsilon(ee)) call abort() + if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee)) call abort() + + ! check Fortran pointer after target-value modification + ee = 55555.0_c_double + !$omp target update to(ee) + call copy3_scalar(c_loc(eptr), c_loc(fptr)) + !$omp target update from(ff) + if (abs(ee - 55555.0_c_double) > 10.0_c_double * epsilon(ee)) call abort() + if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ff)) call abort() + !$omp end target data + + if (abs(ee - 55555.0_c_double) > 10.0_c_double * epsilon(ee)) call abort() + if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee)) call abort() + + + !$omp target data map(to:gg) map(from:hh) + !$omp target data map(alloc:dummy) use_device_addr(gg,hh) + c_gptr = c_loc(gg) + c_hptr = c_loc(hh) + gptr => gg + hptr => hh + !$omp end target data + + ! check c_loc ptr once + call copy3_array(c_gptr, c_hptr, N) + !$omp target update from(hh) + if (any(abs(gg - 777.0_c_double) > 10.0_c_double * epsilon(gg))) call abort() + if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(hh))) call abort() + + ! check c_loc ptr again after target-value modification + gg = 7777.0_c_double + !$omp target update to(gg) + call copy3_array(c_gptr, c_hptr, N) + !$omp target update from(hh) + if (any(abs(gg - 7777.0_c_double) > 10.0_c_double * epsilon(gg))) call abort() + if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(gg))) call abort() + + ! check Fortran pointer after target-value modification + gg = 77777.0_c_double + !$omp target update to(gg) + call copy3_array(c_loc(gptr), c_loc(hptr), N) + !$omp target update from(hh) + if (any(abs(gg - 77777.0_c_double) > 10.0_c_double * epsilon(gg))) call abort() + if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(gg))) call abort() + !$omp end target data + + if (any(abs(gg - 77777.0_c_double) > 10.0_c_double * epsilon(gg))) call abort() + if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(gg))) call abort() + end subroutine test_dummy_callee_2 +end module test_dummies + + + +! Test local dummy arguments + VALUE (w/o optional) +module test_dummies_value + use iso_c_binding + use target_procs + implicit none + private + public :: test_dummy_val_call_1, test_dummy_val_call_2 +contains + subroutine test_dummy_val_call_1() + ! scalars - with value, neither allocatable nor pointer no dimension permitted + real(c_double), target :: aa, bb + + aa = 11.0_c_double + bb = 22.0_c_double + + call test_dummy_val_callee_1(aa, bb) + end subroutine test_dummy_val_call_1 + + subroutine test_dummy_val_callee_1(aa, bb) + ! scalars + real(c_double), value, target :: aa, bb + + !$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb) + call copy3_scalar(c_loc(aa), c_loc(bb)) + !$omp end target data + if (abs(aa - 11.0_c_double) > 10.0_c_double * epsilon(aa)) call abort() + if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort() + end subroutine test_dummy_val_callee_1 + + ! Save device ptr - and recall pointer + subroutine test_dummy_val_call_2() + ! scalars - with value, neither allocatable nor pointer no dimension permitted + real(c_double), target :: aa, bb + type(c_ptr) :: c_aptr, c_bptr + real(c_double), pointer :: aptr, bptr + + call test_dummy_val_callee_2(aa, bb, c_aptr, c_bptr, aptr, bptr) + end subroutine test_dummy_val_call_2 + + subroutine test_dummy_val_callee_2(aa, bb, c_aptr, c_bptr, aptr, bptr) + real(c_double), value, target :: aa, bb + type(c_ptr), value :: c_aptr, c_bptr + real(c_double), pointer :: aptr, bptr + + real(c_double) :: dummy + + aa = 111.0_c_double + bb = 222.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_scalar(c_aptr, c_bptr) + !$omp target update from(bb) + if (abs(aa - 111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort() + if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort() + + ! check c_loc ptr again after target-value modification + aa = 1111.0_c_double + !$omp target update to(aa) + call copy3_scalar(c_aptr, c_bptr) + !$omp target update from(bb) + if (abs(aa - 1111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort() + if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort() + + ! check Fortran pointer after target-value modification + aa = 11111.0_c_double + !$omp target update to(aa) + call copy3_scalar(c_loc(aptr), c_loc(bptr)) + !$omp target update from(bb) + if (abs(aa - 11111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort() + if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort() + !$omp end target data + + if (abs(aa - 11111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort() + if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort() + end subroutine test_dummy_val_callee_2 +end module test_dummies_value + + + +! 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 + private + public :: test_dummy_opt_call_1, test_dummy_opt_call_2 +contains + subroutine test_dummy_opt_call_1() + integer, parameter :: N = 1000 + + ! scalars + real(c_double), target :: aa, bb + real(c_double), target, allocatable :: cc, dd + real(c_double), pointer :: ee, ff + + ! non-descriptor arrays + real(c_double), target :: gg(N), hh(N) + + allocate(cc, dd, ee, ff) + + 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 + gg = 77.0_c_double + hh = 88.0_c_double + + call test_dummy_opt_callee_1(aa, bb, cc, dd, ee, ff, gg, hh, 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, gg, hh, N) + ! scalars + real(c_double), optional, target :: aa, bb + real(c_double), optional, target, allocatable :: cc, dd + real(c_double), optional, pointer :: ee, ff + + ! non-descriptor arrays + real(c_double), optional, target :: gg(N), hh(N) + integer, value :: N + + ! All shall be present - and pointing to non-NULL + if (.not.present(aa) .or. .not.present(bb)) call abort() + if (.not.present(cc) .or. .not.present(dd)) call abort() + if (.not.present(ee) .or. .not.present(ff)) call abort() + if (.not.present(gg) .or. .not.present(hh)) call abort() + + if (.not.associated(ee) .or. .not.associated(ff)) call abort() + + !$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb) + if (.not.present(aa) .or. .not.present(bb)) call abort() + if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) call abort() + call copy3_scalar(c_loc(aa), c_loc(bb)) + !$omp end target data + if (abs(aa - 11.0_c_double) > 10.0_c_double * epsilon(aa)) call abort() + if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort() + + !$omp target data map(to:cc) map(from:dd) use_device_addr(cc,dd) + if (.not.present(cc) .or. .not.present(dd)) call abort() + if (.not.c_associated(c_loc(cc)) .or. .not.c_associated(c_loc(dd))) call abort() + call copy3_scalar(c_loc(cc), c_loc(dd)) + !$omp end target data + if (abs(cc - 33.0_c_double) > 10.0_c_double * epsilon(cc)) call abort() + if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc)) call abort() + + !$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff) + if (.not.present(ee) .or. .not.present(ff)) call abort() + if (.not.associated(ee) .or. .not.associated(ff)) call abort() + if (.not.c_associated(c_loc(ee)) .or. .not.c_associated(c_loc(ff))) call abort() + call copy3_scalar(c_loc(ee), c_loc(ff)) + !$omp end target data + if (abs(ee - 55.0_c_double) > 10.0_c_double * epsilon(ee)) call abort() + if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee)) call abort() + + !$omp target data map(to:gg) map(from:hh) use_device_addr(gg,hh) + if (.not.present(gg) .or. .not.present(hh)) call abort() + if (.not.c_associated(c_loc(gg)) .or. .not.c_associated(c_loc(hh))) call abort() + call copy3_array(c_loc(gg), c_loc(hh), N) + !$omp end target data + if (any(abs(gg - 77.0_c_double) > 10.0_c_double * epsilon(gg))) call abort() + if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(gg))) call abort() + end subroutine test_dummy_opt_callee_1 + + ! Save device ptr - and recall pointer + subroutine test_dummy_opt_call_2() + integer, parameter :: N = 1000 + + ! scalars + real(c_double), target :: aa, bb + real(c_double), target, allocatable :: cc, dd + real(c_double), pointer :: ee, ff + + ! non-descriptor arrays + real(c_double), target :: gg(N), hh(N) + + type(c_ptr) :: c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, c_gptr, c_hptr + real(c_double), pointer :: aptr, bptr, cptr, dptr, eptr, fptr + real(c_double), pointer :: gptr(:), hptr(:) + + allocate(cc, dd, ee, ff) + call test_dummy_opt_callee_2(aa, bb, cc, dd, ee, ff, gg, hh, & + c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, c_gptr, c_hptr, & + aptr, bptr, cptr, dptr, eptr, fptr, gptr, hptr, & + N) + deallocate(ee, ff) + end subroutine test_dummy_opt_call_2 + + subroutine test_dummy_opt_callee_2(aa, bb, cc, dd, ee, ff, gg, hh, & + c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, c_gptr, c_hptr, & + aptr, bptr, cptr, dptr, eptr, fptr, gptr, hptr, & + N) + ! scalars + real(c_double), optional, target :: aa, bb + real(c_double), optional, target, allocatable :: cc, dd + real(c_double), optional, pointer :: ee, ff + + ! non-descriptor arrays + real(c_double), optional, target :: gg(N), hh(N) + + type(c_ptr) :: c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, c_gptr, c_hptr + real(c_double), optional, pointer :: aptr, bptr, cptr, dptr, eptr, fptr + real(c_double), optional, pointer :: gptr(:), hptr(:) + + integer, value :: N + + real(c_double) :: dummy + + ! All shall be present - and pointing to non-NULL + if (.not.present(aa) .or. .not.present(bb)) call abort() + if (.not.present(cc) .or. .not.present(dd)) call abort() + if (.not.present(ee) .or. .not.present(ff)) call abort() + if (.not.present(gg) .or. .not.present(hh)) call abort() + + if (.not.associated(ee) .or. .not.associated(ff)) call abort() + + 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 + gg = 777.0_c_double + hh = 888.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)) call abort() + if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) call abort() + 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)) call abort() + if (.not.associated(aptr) .or. .not.associated(bptr)) call abort() + !$omp end target data + + if (.not.present(aa) .or. .not.present(bb)) call abort() + if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) call abort() + if (.not.c_associated(c_aptr) .or. .not.c_associated(c_bptr)) call abort() + if (.not.associated(aptr) .or. .not.associated(bptr)) call abort() + + ! check c_loc ptr once + call copy3_scalar(c_aptr, c_bptr) + !$omp target update from(bb) + if (abs(aa - 111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort() + if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort() + + ! check c_loc ptr again after target-value modification + aa = 1111.0_c_double + !$omp target update to(aa) + call copy3_scalar(c_aptr, c_bptr) + !$omp target update from(bb) + if (abs(aa - 1111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort() + if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort() + + ! check Fortran pointer after target-value modification + aa = 11111.0_c_double + !$omp target update to(aa) + call copy3_scalar(c_loc(aptr), c_loc(bptr)) + !$omp target update from(bb) + if (abs(aa - 11111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort() + if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort() + !$omp end target data + + if (abs(aa - 11111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort() + if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort() + + + !$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)) call abort() + if (.not.c_associated(c_loc(cc)) .or. .not.c_associated(c_loc(dd))) call abort() + 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)) call abort() + if (.not.associated(cptr) .or. .not.associated(dptr)) call abort() + !$omp end target data + if (.not.present(cc) .or. .not.present(dd)) call abort() + if (.not.c_associated(c_loc(cc)) .or. .not.c_associated(c_loc(dd))) call abort() + if (.not.c_associated(c_cptr) .or. .not.c_associated(c_dptr)) call abort() + if (.not.associated(cptr) .or. .not.associated(dptr)) call abort() + + ! check c_loc ptr once + call copy3_scalar(c_cptr, c_dptr) + !$omp target update from(dd) + if (abs(cc - 333.0_c_double) > 10.0_c_double * epsilon(cc)) call abort() + if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc)) call abort() + + ! check c_loc ptr again after target-value modification + cc = 3333.0_c_double + !$omp target update to(cc) + call copy3_scalar(c_cptr, c_dptr) + !$omp target update from(dd) + if (abs(cc - 3333.0_c_double) > 10.0_c_double * epsilon(cc)) call abort() + if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc)) call abort() + + ! check Fortran pointer after target-value modification + cc = 33333.0_c_double + !$omp target update to(cc) + call copy3_scalar(c_loc(cptr), c_loc(dptr)) + !$omp target update from(dd) + if (abs(cc - 33333.0_c_double) > 10.0_c_double * epsilon(cc)) call abort() + if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc)) call abort() + !$omp end target data + + if (abs(cc - 33333.0_c_double) > 10.0_c_double * epsilon(dd)) call abort() + if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(dd)) call abort() + + + !$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)) call abort() + if (.not.associated(ee) .or. .not.associated(ff)) call abort() + if (.not.c_associated(c_loc(ee)) .or. .not.c_associated(c_loc(ff))) call abort() + 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)) call abort() + if (.not.associated(eptr) .or. .not.associated(fptr)) call abort() + !$omp end target data + if (.not.present(ee) .or. .not.present(ff)) call abort() + if (.not.associated(ee) .or. .not.associated(ff)) call abort() + if (.not.c_associated(c_loc(ee)) .or. .not.c_associated(c_loc(ff))) call abort() + if (.not.c_associated(c_eptr) .or. .not.c_associated(c_fptr)) call abort() + if (.not.associated(eptr) .or. .not.associated(fptr)) call abort() + + ! check c_loc ptr once + call copy3_scalar(c_eptr, c_fptr) + !$omp target update from(ff) + if (abs(ee - 555.0_c_double) > 10.0_c_double * epsilon(ee)) call abort() + if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee)) call abort() + + ! check c_loc ptr again after target-value modification + ee = 5555.0_c_double + !$omp target update to(ee) + call copy3_scalar(c_eptr, c_fptr) + !$omp target update from(ff) + if (abs(ee - 5555.0_c_double) > 10.0_c_double * epsilon(ee)) call abort() + if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee)) call abort() + + ! check Fortran pointer after target-value modification + ee = 55555.0_c_double + !$omp target update to(ee) + call copy3_scalar(c_loc(eptr), c_loc(fptr)) + !$omp target update from(ff) + if (abs(ee - 55555.0_c_double) > 10.0_c_double * epsilon(ee)) call abort() + if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ff)) call abort() + !$omp end target data + + if (abs(ee - 55555.0_c_double) > 10.0_c_double * epsilon(ee)) call abort() + if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee)) call abort() + + + !$omp target data map(to:gg) map(from:hh) + !$omp target data map(alloc:dummy) use_device_addr(gg,hh) + if (.not.present(gg) .or. .not.present(hh)) call abort() + if (.not.c_associated(c_loc(gg)) .or. .not.c_associated(c_loc(hh))) call abort() + c_gptr = c_loc(gg) + c_hptr = c_loc(hh) + gptr => gg + hptr => hh + if (.not.c_associated(c_gptr) .or. .not.c_associated(c_hptr)) call abort() + if (.not.associated(gptr) .or. .not.associated(hptr)) call abort() + !$omp end target data + if (.not.present(gg) .or. .not.present(hh)) call abort() + if (.not.c_associated(c_loc(gg)) .or. .not.c_associated(c_loc(hh))) call abort() + if (.not.c_associated(c_gptr) .or. .not.c_associated(c_hptr)) call abort() + if (.not.associated(gptr) .or. .not.associated(hptr)) call abort() + + ! check c_loc ptr once + call copy3_array(c_gptr, c_hptr, N) + !$omp target update from(hh) + if (any(abs(gg - 777.0_c_double) > 10.0_c_double * epsilon(gg))) call abort() + if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(hh))) call abort() + + ! check c_loc ptr again after target-value modification + gg = 7777.0_c_double + !$omp target update to(gg) + call copy3_array(c_gptr, c_hptr, N) + !$omp target update from(hh) + if (any(abs(gg - 7777.0_c_double) > 10.0_c_double * epsilon(gg))) call abort() + if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(gg))) call abort() + + ! check Fortran pointer after target-value modification + gg = 77777.0_c_double + !$omp target update to(gg) + call copy3_array(c_loc(gptr), c_loc(hptr), N) + !$omp target update from(hh) + if (any(abs(gg - 77777.0_c_double) > 10.0_c_double * epsilon(gg))) call abort() + if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(gg))) call abort() + !$omp end target data + + if (any(abs(gg - 77777.0_c_double) > 10.0_c_double * epsilon(gg))) call abort() + if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(gg))) call abort() + end subroutine test_dummy_opt_callee_2 +end module test_dummies_opt + + + +! Test local dummy arguments + OPTIONAL + VALUE +! Values present +module test_dummies_opt_value + use iso_c_binding + use target_procs + implicit none + private + public :: test_dummy_opt_val_call_1, test_dummy_opt_val_call_2 +contains + subroutine test_dummy_opt_val_call_1() + ! scalars - with value, neither allocatable nor pointer no dimension permitted + real(c_double), target :: aa, bb + + aa = 11.0_c_double + bb = 22.0_c_double + + call test_dummy_opt_val_callee_1(aa, bb) + end subroutine test_dummy_opt_val_call_1 + + subroutine test_dummy_opt_val_callee_1(aa, bb) + ! scalars + real(c_double), optional, value, target :: aa, bb + + if (.not.present(aa) .or. .not.present(bb)) call abort() + + !$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb) + if (.not.present(aa) .or. .not.present(bb)) call abort() + if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) call abort() + call copy3_scalar(c_loc(aa), c_loc(bb)) + !$omp end target data + if (abs(aa - 11.0_c_double) > 10.0_c_double * epsilon(aa)) call abort() + if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort() + end subroutine test_dummy_opt_val_callee_1 + + ! Save device ptr - and recall pointer + subroutine test_dummy_opt_val_call_2() + ! scalars - with value, neither allocatable nor pointer no dimension permitted + real(c_double), target :: aa, bb + type(c_ptr) :: c_aptr, c_bptr + real(c_double), pointer :: aptr, bptr + + call test_dummy_opt_val_callee_2(aa, bb, c_aptr, c_bptr, aptr, bptr) + end subroutine test_dummy_opt_val_call_2 + + subroutine test_dummy_opt_val_callee_2(aa, bb, c_aptr, c_bptr, aptr, bptr) + real(c_double), optional, value, target :: aa, bb + type(c_ptr), optional, value :: c_aptr, c_bptr + real(c_double), optional, pointer :: aptr, bptr + + real(c_double) :: dummy + + if (.not.present(aa) .or. .not.present(bb)) call abort() + if (.not.present(c_aptr) .or. .not.present(c_bptr)) call abort() + if (.not.present(aptr) .or. .not.present(bptr)) call abort() + + aa = 111.0_c_double + bb = 222.0_c_double + + !$omp target data map(to:aa) map(from:bb) + if (.not.present(aa) .or. .not.present(bb)) call abort() + if (.not.present(c_aptr) .or. .not.present(c_bptr)) call abort() + if (.not.present(aptr) .or. .not.present(bptr)) call abort() + + !$omp target data map(alloc:dummy) use_device_addr(aa,bb) + if (.not.present(aa) .or. .not.present(bb)) call abort() + if (.not.present(c_aptr) .or. .not.present(c_bptr)) call abort() + if (.not.present(aptr) .or. .not.present(bptr)) call abort() + + 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)) call abort() + if (.not.associated(aptr) .or. .not.associated(bptr)) call abort() + !$omp end target data + + ! check c_loc ptr once + call copy3_scalar(c_aptr, c_bptr) + !$omp target update from(bb) + if (abs(aa - 111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort() + if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort() + + ! check c_loc ptr again after target-value modification + aa = 1111.0_c_double + !$omp target update to(aa) + call copy3_scalar(c_aptr, c_bptr) + !$omp target update from(bb) + if (abs(aa - 1111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort() + if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort() + + ! check Fortran pointer after target-value modification + aa = 11111.0_c_double + !$omp target update to(aa) + call copy3_scalar(c_loc(aptr), c_loc(bptr)) + !$omp target update from(bb) + if (abs(aa - 11111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort() + if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort() + !$omp end target data + + if (abs(aa - 11111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort() + if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort() + end subroutine test_dummy_opt_val_callee_2 +end module test_dummies_opt_value + + + +! Test nullptr +module test_nullptr + use iso_c_binding + implicit none + private + public :: test_nullptr_1 +contains + subroutine test_nullptr_1() + ! scalars + real(c_double), pointer :: aa, bb + real(c_double), pointer :: ee, ff + + type(c_ptr) :: c_aptr, c_bptr, c_eptr, c_fptr + real(c_double), pointer :: aptr, bptr, eptr, fptr + + aa => null() + bb => null() + ee => null() + ff => null() + + if (associated(aa) .or. associated(bb)) call abort() + !$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))) call abort() + c_aptr = c_loc(aa) + c_bptr = c_loc(bb) + aptr => aa + bptr => bb + if (c_associated(c_aptr) .or. c_associated(c_bptr)) call abort() + if (associated(aptr) .or. associated(bptr, bb)) call abort() + !$omp end target data + if (c_associated(c_aptr) .or. c_associated(c_bptr)) call abort() + if (associated(aptr) .or. associated(bptr, bb)) call abort() + + call test_dummy_opt_nullptr_callee_1(ee, ff, c_eptr, c_fptr, eptr, fptr) + end subroutine test_nullptr_1 + + subroutine test_dummy_opt_nullptr_callee_1(ee, ff, c_eptr, c_fptr, eptr, fptr) + ! scalars + real(c_double), optional, pointer :: ee, ff + + type(c_ptr), optional :: c_eptr, c_fptr + real(c_double), optional, pointer :: eptr, fptr + + if (.not.present(ee) .or. .not.present(ff)) call abort() + if (associated(ee) .or. associated(ff)) call abort() + + !$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff) + if (.not.present(ee) .or. .not.present(ff)) call abort() + if (associated(ee) .or. associated(ff)) call abort() + if (c_associated(c_loc(ee)) .or. c_associated(c_loc(ff))) call abort() + c_eptr = c_loc(ee) + c_fptr = c_loc(ff) + eptr => ee + fptr => ff + if (c_associated(c_eptr) .or. c_associated(c_fptr)) call abort() + if (associated(eptr) .or. associated(fptr)) call abort() + !$omp end target data + + if (c_associated(c_eptr) .or. c_associated(c_fptr)) call abort() + if (associated(eptr) .or. associated(fptr)) call abort() + 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 + private + public :: test_main_1, test_main_2 +contains + ! map + use_device_addr + c_loc + subroutine test_main_1() + integer, parameter :: N = 1000 + + ! scalars + real(c_double), target :: aa, bb + real(c_double), target, allocatable :: cc, dd + real(c_double), pointer :: ee, ff + + ! non-descriptor arrays + real(c_double), target :: gg(N), hh(N) + + allocate(cc, dd, ee, ff) + + + 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 + gg = 77.0_c_double + hh = 88.0_c_double + + !$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb) + call copy3_scalar(c_loc(aa), c_loc(bb)) + !$omp end target data + if (abs(aa - 11.0_c_double) > 10.0_c_double * epsilon(aa)) call abort() + if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort() + + !$omp target data map(to:cc) map(from:dd) use_device_addr(cc,dd) + call copy3_scalar(c_loc(cc), c_loc(dd)) + !$omp end target data + if (abs(cc - 33.0_c_double) > 10.0_c_double * epsilon(cc)) call abort() + if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc)) call abort() + + !$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff) + call copy3_scalar(c_loc(ee), c_loc(ff)) + !$omp end target data + if (abs(ee - 55.0_c_double) > 10.0_c_double * epsilon(ee)) call abort() + if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee)) call abort() + + + !$omp target data map(to:gg) map(from:hh) use_device_addr(gg,hh) + call copy3_array(c_loc(gg), c_loc(hh), N) + !$omp end target data + if (any(abs(gg - 77.0_c_double) > 10.0_c_double * epsilon(gg))) call abort() + if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(gg))) call abort() + + deallocate(ee, ff) ! pointers, only + end subroutine test_main_1 + + ! Save device ptr - and recall pointer + subroutine test_main_2 + integer, parameter :: N = 1000 + + ! scalars + real(c_double), target :: aa, bb + real(c_double), target, allocatable :: cc, dd + real(c_double), pointer :: ee, ff + + ! non-descriptor arrays + real(c_double), target :: gg(N), hh(N) + + real(c_double) :: dummy + type(c_ptr) :: c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, c_gptr, c_hptr + real(c_double), pointer :: aptr, bptr, cptr, dptr, eptr, fptr + real(c_double), pointer :: gptr(:), hptr(:) + + allocate(cc, dd, ee, ff) + + 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 + gg = 777.0_c_double + hh = 888.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_scalar(c_aptr, c_bptr) + !$omp target update from(bb) + if (abs(aa - 111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort() + if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort() + + ! check c_loc ptr again after target-value modification + aa = 1111.0_c_double + !$omp target update to(aa) + call copy3_scalar(c_aptr, c_bptr) + !$omp target update from(bb) + if (abs(aa - 1111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort() + if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort() + + ! check Fortran pointer after target-value modification + aa = 11111.0_c_double + !$omp target update to(aa) + call copy3_scalar(c_loc(aptr), c_loc(bptr)) + !$omp target update from(bb) + if (abs(aa - 11111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort() + if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort() + !$omp end target data + + if (abs(aa - 11111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort() + if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort() + + + !$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_scalar(c_cptr, c_dptr) + !$omp target update from(dd) + if (abs(cc - 333.0_c_double) > 10.0_c_double * epsilon(cc)) call abort() + if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc)) call abort() + + ! check c_loc ptr again after target-value modification + cc = 3333.0_c_double + !$omp target update to(cc) + call copy3_scalar(c_cptr, c_dptr) + !$omp target update from(dd) + if (abs(cc - 3333.0_c_double) > 10.0_c_double * epsilon(cc)) call abort() + if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc)) call abort() + + ! check Fortran pointer after target-value modification + cc = 33333.0_c_double + !$omp target update to(cc) + call copy3_scalar(c_loc(cptr), c_loc(dptr)) + !$omp target update from(dd) + if (abs(cc - 33333.0_c_double) > 10.0_c_double * epsilon(cc)) call abort() + if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc)) call abort() + !$omp end target data + + if (abs(cc - 33333.0_c_double) > 10.0_c_double * epsilon(dd)) call abort() + if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(dd)) call abort() + + + !$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_scalar(c_eptr, c_fptr) + !$omp target update from(ff) + if (abs(ee - 555.0_c_double) > 10.0_c_double * epsilon(ee)) call abort() + if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee)) call abort() + + ! check c_loc ptr again after target-value modification + ee = 5555.0_c_double + !$omp target update to(ee) + call copy3_scalar(c_eptr, c_fptr) + !$omp target update from(ff) + if (abs(ee - 5555.0_c_double) > 10.0_c_double * epsilon(ee)) call abort() + if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee)) call abort() + + ! check Fortran pointer after target-value modification + ee = 55555.0_c_double + !$omp target update to(ee) + call copy3_scalar(c_loc(eptr), c_loc(fptr)) + !$omp target update from(ff) + if (abs(ee - 55555.0_c_double) > 10.0_c_double * epsilon(ee)) call abort() + if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ff)) call abort() + !$omp end target data + + if (abs(ee - 55555.0_c_double) > 10.0_c_double * epsilon(ee)) call abort() + if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee)) call abort() + + + !$omp target data map(to:gg) map(from:hh) + !$omp target data map(alloc:dummy) use_device_addr(gg,hh) + c_gptr = c_loc(gg) + c_hptr = c_loc(hh) + gptr => gg + hptr => hh + !$omp end target data + + ! check c_loc ptr once + call copy3_array(c_gptr, c_hptr, N) + !$omp target update from(hh) + if (any(abs(gg - 777.0_c_double) > 10.0_c_double * epsilon(gg))) call abort() + if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(hh))) call abort() + + ! check c_loc ptr again after target-value modification + gg = 7777.0_c_double + !$omp target update to(gg) + call copy3_array(c_gptr, c_hptr, N) + !$omp target update from(hh) + if (any(abs(gg - 7777.0_c_double) > 10.0_c_double * epsilon(gg))) call abort() + if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(gg))) call abort() + + ! check Fortran pointer after target-value modification + gg = 77777.0_c_double + !$omp target update to(gg) + call copy3_array(c_loc(gptr), c_loc(hptr), N) + !$omp target update from(hh) + if (any(abs(gg - 77777.0_c_double) > 10.0_c_double * epsilon(gg))) call abort() + if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(gg))) call abort() + !$omp end target data + + if (any(abs(gg - 77777.0_c_double) > 10.0_c_double * epsilon(gg))) call abort() + if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(gg))) call abort() + + deallocate(ee, ff) + end subroutine test_main_2 +end module tests + + +program omp_device_addr + use tests + use test_dummies + use test_dummies_value + use test_dummies_opt + use test_dummies_opt_value + use test_nullptr + implicit none + + call test_main_1() + call test_main_2() + + call test_dummy_call_1() + call test_dummy_call_2() + + call test_dummy_val_call_1() + call test_dummy_val_call_2() + + call test_dummy_opt_call_1() + call test_dummy_opt_call_2() + + call test_dummy_opt_val_call_1() + call test_dummy_opt_val_call_2() + + call test_nullptr_1() +end program omp_device_addr diff --git a/libgomp/testsuite/libgomp.fortran/use_device_addr-2.f90 b/libgomp/testsuite/libgomp.fortran/use_device_addr-2.f90 new file mode 100644 index 00000000000..873700105b6 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/use_device_addr-2.f90 @@ -0,0 +1,1202 @@ +! Comprehensive run-time test for use_device_addr +! +! Differs from use_device_addr-1.f90 by using a 4-byte variable (c_float) +! +! 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: +! - arrays with array descriptor +! - polymorphic variables +! - absent optional arguments +! +module target_procs + use iso_c_binding + implicit none + private + public :: copy3_array, copy3_scalar +contains + subroutine copy3_array_int(from_intptr, to_intptr, N) + !$omp declare target + !type(c_ptr), value :: from, to + integer(c_intptr_t), value :: from_intptr, to_intptr ! VALUE issue, cf. copy3_array + type(c_ptr) :: from, to + integer, value :: N + + real(c_float), pointer :: from_ptr(:) + real(c_float), pointer :: to_ptr(:) + integer :: i + + from = transfer(from_intptr, mold=from) + to = transfer(to_intptr, mold=to) + call c_f_pointer(from, from_ptr, shape=[N]) + call c_f_pointer(to, to_ptr, shape=[N]) + + !$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_scalar_int(from_intptr, to_intptr) + !$omp declare target + !type(c_ptr), value :: from, to + integer(c_intptr_t), value :: from_intptr, to_intptr ! VALUE issue, cf. copy3_array + type(c_ptr) :: from, to + + real(c_float), pointer :: from_ptr + real(c_float), pointer :: to_ptr + + from = transfer(from_intptr, mold=from) + to = transfer(to_intptr, mold=to) + call c_f_pointer(from, from_ptr) + call c_f_pointer(to, to_ptr) + + to_ptr = 3 * from_ptr + end subroutine copy3_scalar_int + + + subroutine copy3_array(from, to, N) + type(c_ptr) :: from, to + integer, value :: N +! [OpenMP issue:] Would like to use the following but it is not permitted due to VALUE. +! !$omp target is_device_ptr(from, to) +! call copy3_array_int(from, to, N) +! !$omp end target +! Hence: + integer(c_intptr_t) :: from_intptr, to_intptr + + from_intptr = transfer(from, mold=from_intptr) + to_intptr = transfer(to, mold=to_intptr) + + !$omp target + call copy3_array_int(from_intptr, to_intptr, N) + !$omp end target + end subroutine copy3_array + + subroutine copy3_scalar(from, to) + type(c_ptr), value :: from, to ! VALUE issue, cf. copy3_array above + integer(c_intptr_t) :: from_intptr, to_intptr + + from_intptr = transfer(from, mold=from_intptr) + to_intptr = transfer(to, mold=to_intptr) + + !$omp target + call copy3_scalar_int(from_intptr, to_intptr) + !$omp end target + end subroutine copy3_scalar +end module target_procs + + + +! Test local dummy arguments (w/o optional) +module test_dummies + use iso_c_binding + use target_procs + implicit none + private + public :: test_dummy_call_1, test_dummy_call_2 +contains + subroutine test_dummy_call_1() + integer, parameter :: N = 1000 + + ! scalars + real(c_float), target :: aa, bb + real(c_float), target, allocatable :: cc, dd + real(c_float), pointer :: ee, ff + + ! non-descriptor arrays + real(c_float), target :: gg(N), hh(N) + + allocate(cc, dd, ee, ff) + + aa = 11.0_c_float + bb = 22.0_c_float + cc = 33.0_c_float + dd = 44.0_c_float + ee = 55.0_c_float + ff = 66.0_c_float + gg = 77.0_c_float + hh = 88.0_c_float + + call test_dummy_callee_1(aa, bb, cc, dd, ee, ff, gg, hh, N) + deallocate(ee, ff) ! pointers, only + end subroutine test_dummy_call_1 + + subroutine test_dummy_callee_1(aa, bb, cc, dd, ee, ff, gg, hh, N) + ! scalars + real(c_float), target :: aa, bb + real(c_float), target, allocatable :: cc, dd + real(c_float), pointer :: ee, ff + + ! non-descriptor arrays + real(c_float), target :: gg(N), hh(N) + integer, value :: N + + !$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb) + call copy3_scalar(c_loc(aa), c_loc(bb)) + !$omp end target data + if (abs(aa - 11.0_c_float) > 10.0_c_float * epsilon(aa)) call abort() + if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort() + + !$omp target data map(to:cc) map(from:dd) use_device_addr(cc,dd) + call copy3_scalar(c_loc(cc), c_loc(dd)) + !$omp end target data + if (abs(cc - 33.0_c_float) > 10.0_c_float * epsilon(cc)) call abort() + if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) call abort() + + !$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff) + call copy3_scalar(c_loc(ee), c_loc(ff)) + !$omp end target data + if (abs(ee - 55.0_c_float) > 10.0_c_float * epsilon(ee)) call abort() + if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) call abort() + + + !$omp target data map(to:gg) map(from:hh) use_device_addr(gg,hh) + call copy3_array(c_loc(gg), c_loc(hh), N) + !$omp end target data + if (any(abs(gg - 77.0_c_float) > 10.0_c_float * epsilon(gg))) call abort() + if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) call abort() + end subroutine test_dummy_callee_1 + + ! Save device ptr - and recall pointer + subroutine test_dummy_call_2() + integer, parameter :: N = 1000 + + ! scalars + real(c_float), target :: aa, bb + real(c_float), target, allocatable :: cc, dd + real(c_float), pointer :: ee, ff + + ! non-descriptor arrays + real(c_float), target :: gg(N), hh(N) + + type(c_ptr) :: c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, c_gptr, c_hptr + real(c_float), pointer :: aptr, bptr, cptr, dptr, eptr, fptr + real(c_float), pointer :: gptr(:), hptr(:) + + allocate(cc, dd, ee, ff) + call test_dummy_callee_2(aa, bb, cc, dd, ee, ff, gg, hh, & + c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, c_gptr, c_hptr, & + aptr, bptr, cptr, dptr, eptr, fptr, gptr, hptr, & + N) + deallocate(ee, ff) + end subroutine test_dummy_call_2 + + subroutine test_dummy_callee_2(aa, bb, cc, dd, ee, ff, gg, hh, & + c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, c_gptr, c_hptr, & + aptr, bptr, cptr, dptr, eptr, fptr, gptr, hptr, & + N) + ! scalars + real(c_float), target :: aa, bb + real(c_float), target, allocatable :: cc, dd + real(c_float), pointer :: ee, ff + + ! non-descriptor arrays + real(c_float), target :: gg(N), hh(N) + + type(c_ptr) :: c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, c_gptr, c_hptr + real(c_float), pointer :: aptr, bptr, cptr, dptr, eptr, fptr + real(c_float), pointer :: gptr(:), hptr(:) + + integer, value :: N + + real(c_float) :: dummy + + aa = 111.0_c_float + bb = 222.0_c_float + cc = 333.0_c_float + dd = 444.0_c_float + ee = 555.0_c_float + ff = 666.0_c_float + gg = 777.0_c_float + hh = 888.0_c_float + + !$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_scalar(c_aptr, c_bptr) + !$omp target update from(bb) + if (abs(aa - 111.0_c_float) > 10.0_c_float * epsilon(aa)) call abort() + if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort() + + ! check c_loc ptr again after target-value modification + aa = 1111.0_c_float + !$omp target update to(aa) + call copy3_scalar(c_aptr, c_bptr) + !$omp target update from(bb) + if (abs(aa - 1111.0_c_float) > 10.0_c_float * epsilon(aa)) call abort() + if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort() + + ! check Fortran pointer after target-value modification + aa = 11111.0_c_float + !$omp target update to(aa) + call copy3_scalar(c_loc(aptr), c_loc(bptr)) + !$omp target update from(bb) + if (abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa)) call abort() + if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort() + !$omp end target data + + if (abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa)) call abort() + if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort() + + + !$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_scalar(c_cptr, c_dptr) + !$omp target update from(dd) + if (abs(cc - 333.0_c_float) > 10.0_c_float * epsilon(cc)) call abort() + if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) call abort() + + ! check c_loc ptr again after target-value modification + cc = 3333.0_c_float + !$omp target update to(cc) + call copy3_scalar(c_cptr, c_dptr) + !$omp target update from(dd) + if (abs(cc - 3333.0_c_float) > 10.0_c_float * epsilon(cc)) call abort() + if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) call abort() + + ! check Fortran pointer after target-value modification + cc = 33333.0_c_float + !$omp target update to(cc) + call copy3_scalar(c_loc(cptr), c_loc(dptr)) + !$omp target update from(dd) + if (abs(cc - 33333.0_c_float) > 10.0_c_float * epsilon(cc)) call abort() + if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) call abort() + !$omp end target data + + if (abs(cc - 33333.0_c_float) > 10.0_c_float * epsilon(dd)) call abort() + if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(dd)) call abort() + + + !$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_scalar(c_eptr, c_fptr) + !$omp target update from(ff) + if (abs(ee - 555.0_c_float) > 10.0_c_float * epsilon(ee)) call abort() + if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) call abort() + + ! check c_loc ptr again after target-value modification + ee = 5555.0_c_float + !$omp target update to(ee) + call copy3_scalar(c_eptr, c_fptr) + !$omp target update from(ff) + if (abs(ee - 5555.0_c_float) > 10.0_c_float * epsilon(ee)) call abort() + if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) call abort() + + ! check Fortran pointer after target-value modification + ee = 55555.0_c_float + !$omp target update to(ee) + call copy3_scalar(c_loc(eptr), c_loc(fptr)) + !$omp target update from(ff) + if (abs(ee - 55555.0_c_float) > 10.0_c_float * epsilon(ee)) call abort() + if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ff)) call abort() + !$omp end target data + + if (abs(ee - 55555.0_c_float) > 10.0_c_float * epsilon(ee)) call abort() + if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) call abort() + + + !$omp target data map(to:gg) map(from:hh) + !$omp target data map(alloc:dummy) use_device_addr(gg,hh) + c_gptr = c_loc(gg) + c_hptr = c_loc(hh) + gptr => gg + hptr => hh + !$omp end target data + + ! check c_loc ptr once + call copy3_array(c_gptr, c_hptr, N) + !$omp target update from(hh) + if (any(abs(gg - 777.0_c_float) > 10.0_c_float * epsilon(gg))) call abort() + if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(hh))) call abort() + + ! check c_loc ptr again after target-value modification + gg = 7777.0_c_float + !$omp target update to(gg) + call copy3_array(c_gptr, c_hptr, N) + !$omp target update from(hh) + if (any(abs(gg - 7777.0_c_float) > 10.0_c_float * epsilon(gg))) call abort() + if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) call abort() + + ! check Fortran pointer after target-value modification + gg = 77777.0_c_float + !$omp target update to(gg) + call copy3_array(c_loc(gptr), c_loc(hptr), N) + !$omp target update from(hh) + if (any(abs(gg - 77777.0_c_float) > 10.0_c_float * epsilon(gg))) call abort() + if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) call abort() + !$omp end target data + + if (any(abs(gg - 77777.0_c_float) > 10.0_c_float * epsilon(gg))) call abort() + if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) call abort() + end subroutine test_dummy_callee_2 +end module test_dummies + + + +! Test local dummy arguments + VALUE (w/o optional) +module test_dummies_value + use iso_c_binding + use target_procs + implicit none + private + public :: test_dummy_val_call_1, test_dummy_val_call_2 +contains + subroutine test_dummy_val_call_1() + ! scalars - with value, neither allocatable nor pointer no dimension permitted + real(c_float), target :: aa, bb + + aa = 11.0_c_float + bb = 22.0_c_float + + call test_dummy_val_callee_1(aa, bb) + end subroutine test_dummy_val_call_1 + + subroutine test_dummy_val_callee_1(aa, bb) + ! scalars + real(c_float), value, target :: aa, bb + + !$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb) + call copy3_scalar(c_loc(aa), c_loc(bb)) + !$omp end target data + if (abs(aa - 11.0_c_float) > 10.0_c_float * epsilon(aa)) call abort() + if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort() + end subroutine test_dummy_val_callee_1 + + ! Save device ptr - and recall pointer + subroutine test_dummy_val_call_2() + ! scalars - with value, neither allocatable nor pointer no dimension permitted + real(c_float), target :: aa, bb + type(c_ptr) :: c_aptr, c_bptr + real(c_float), pointer :: aptr, bptr + + call test_dummy_val_callee_2(aa, bb, c_aptr, c_bptr, aptr, bptr) + end subroutine test_dummy_val_call_2 + + subroutine test_dummy_val_callee_2(aa, bb, c_aptr, c_bptr, aptr, bptr) + real(c_float), value, target :: aa, bb + type(c_ptr), value :: c_aptr, c_bptr + real(c_float), pointer :: aptr, bptr + + real(c_float) :: dummy + + aa = 111.0_c_float + bb = 222.0_c_float + + !$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_scalar(c_aptr, c_bptr) + !$omp target update from(bb) + if (abs(aa - 111.0_c_float) > 10.0_c_float * epsilon(aa)) call abort() + if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort() + + ! check c_loc ptr again after target-value modification + aa = 1111.0_c_float + !$omp target update to(aa) + call copy3_scalar(c_aptr, c_bptr) + !$omp target update from(bb) + if (abs(aa - 1111.0_c_float) > 10.0_c_float * epsilon(aa)) call abort() + if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort() + + ! check Fortran pointer after target-value modification + aa = 11111.0_c_float + !$omp target update to(aa) + call copy3_scalar(c_loc(aptr), c_loc(bptr)) + !$omp target update from(bb) + if (abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa)) call abort() + if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort() + !$omp end target data + + if (abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa)) call abort() + if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort() + end subroutine test_dummy_val_callee_2 +end module test_dummies_value + + + +! 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 + private + public :: test_dummy_opt_call_1, test_dummy_opt_call_2 +contains + subroutine test_dummy_opt_call_1() + integer, parameter :: N = 1000 + + ! scalars + real(c_float), target :: aa, bb + real(c_float), target, allocatable :: cc, dd + real(c_float), pointer :: ee, ff + + ! non-descriptor arrays + real(c_float), target :: gg(N), hh(N) + + allocate(cc, dd, ee, ff) + + aa = 11.0_c_float + bb = 22.0_c_float + cc = 33.0_c_float + dd = 44.0_c_float + ee = 55.0_c_float + ff = 66.0_c_float + gg = 77.0_c_float + hh = 88.0_c_float + + call test_dummy_opt_callee_1(aa, bb, cc, dd, ee, ff, gg, hh, 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, gg, hh, N) + ! scalars + real(c_float), optional, target :: aa, bb + real(c_float), optional, target, allocatable :: cc, dd + real(c_float), optional, pointer :: ee, ff + + ! non-descriptor arrays + real(c_float), optional, target :: gg(N), hh(N) + integer, value :: N + + ! All shall be present - and pointing to non-NULL + if (.not.present(aa) .or. .not.present(bb)) call abort() + if (.not.present(cc) .or. .not.present(dd)) call abort() + if (.not.present(ee) .or. .not.present(ff)) call abort() + if (.not.present(gg) .or. .not.present(hh)) call abort() + + if (.not.associated(ee) .or. .not.associated(ff)) call abort() + + !$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb) + if (.not.present(aa) .or. .not.present(bb)) call abort() + if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) call abort() + call copy3_scalar(c_loc(aa), c_loc(bb)) + !$omp end target data + if (abs(aa - 11.0_c_float) > 10.0_c_float * epsilon(aa)) call abort() + if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort() + + !$omp target data map(to:cc) map(from:dd) use_device_addr(cc,dd) + if (.not.present(cc) .or. .not.present(dd)) call abort() + if (.not.c_associated(c_loc(cc)) .or. .not.c_associated(c_loc(dd))) call abort() + call copy3_scalar(c_loc(cc), c_loc(dd)) + !$omp end target data + if (abs(cc - 33.0_c_float) > 10.0_c_float * epsilon(cc)) call abort() + if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) call abort() + + !$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff) + if (.not.present(ee) .or. .not.present(ff)) call abort() + if (.not.associated(ee) .or. .not.associated(ff)) call abort() + if (.not.c_associated(c_loc(ee)) .or. .not.c_associated(c_loc(ff))) call abort() + call copy3_scalar(c_loc(ee), c_loc(ff)) + !$omp end target data + if (abs(ee - 55.0_c_float) > 10.0_c_float * epsilon(ee)) call abort() + if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) call abort() + + !$omp target data map(to:gg) map(from:hh) use_device_addr(gg,hh) + if (.not.present(gg) .or. .not.present(hh)) call abort() + if (.not.c_associated(c_loc(gg)) .or. .not.c_associated(c_loc(hh))) call abort() + call copy3_array(c_loc(gg), c_loc(hh), N) + !$omp end target data + if (any(abs(gg - 77.0_c_float) > 10.0_c_float * epsilon(gg))) call abort() + if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) call abort() + end subroutine test_dummy_opt_callee_1 + + ! Save device ptr - and recall pointer + subroutine test_dummy_opt_call_2() + integer, parameter :: N = 1000 + + ! scalars + real(c_float), target :: aa, bb + real(c_float), target, allocatable :: cc, dd + real(c_float), pointer :: ee, ff + + ! non-descriptor arrays + real(c_float), target :: gg(N), hh(N) + + type(c_ptr) :: c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, c_gptr, c_hptr + real(c_float), pointer :: aptr, bptr, cptr, dptr, eptr, fptr + real(c_float), pointer :: gptr(:), hptr(:) + + allocate(cc, dd, ee, ff) + call test_dummy_opt_callee_2(aa, bb, cc, dd, ee, ff, gg, hh, & + c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, c_gptr, c_hptr, & + aptr, bptr, cptr, dptr, eptr, fptr, gptr, hptr, & + N) + deallocate(ee, ff) + end subroutine test_dummy_opt_call_2 + + subroutine test_dummy_opt_callee_2(aa, bb, cc, dd, ee, ff, gg, hh, & + c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, c_gptr, c_hptr, & + aptr, bptr, cptr, dptr, eptr, fptr, gptr, hptr, & + N) + ! scalars + real(c_float), optional, target :: aa, bb + real(c_float), optional, target, allocatable :: cc, dd + real(c_float), optional, pointer :: ee, ff + + ! non-descriptor arrays + real(c_float), optional, target :: gg(N), hh(N) + + type(c_ptr) :: c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, c_gptr, c_hptr + real(c_float), optional, pointer :: aptr, bptr, cptr, dptr, eptr, fptr + real(c_float), optional, pointer :: gptr(:), hptr(:) + + integer, value :: N + + real(c_float) :: dummy + + ! All shall be present - and pointing to non-NULL + if (.not.present(aa) .or. .not.present(bb)) call abort() + if (.not.present(cc) .or. .not.present(dd)) call abort() + if (.not.present(ee) .or. .not.present(ff)) call abort() + if (.not.present(gg) .or. .not.present(hh)) call abort() + + if (.not.associated(ee) .or. .not.associated(ff)) call abort() + + aa = 111.0_c_float + bb = 222.0_c_float + cc = 333.0_c_float + dd = 444.0_c_float + ee = 555.0_c_float + ff = 666.0_c_float + gg = 777.0_c_float + hh = 888.0_c_float + + !$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)) call abort() + if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) call abort() + 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)) call abort() + if (.not.associated(aptr) .or. .not.associated(bptr)) call abort() + !$omp end target data + + if (.not.present(aa) .or. .not.present(bb)) call abort() + if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) call abort() + if (.not.c_associated(c_aptr) .or. .not.c_associated(c_bptr)) call abort() + if (.not.associated(aptr) .or. .not.associated(bptr)) call abort() + + ! check c_loc ptr once + call copy3_scalar(c_aptr, c_bptr) + !$omp target update from(bb) + if (abs(aa - 111.0_c_float) > 10.0_c_float * epsilon(aa)) call abort() + if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort() + + ! check c_loc ptr again after target-value modification + aa = 1111.0_c_float + !$omp target update to(aa) + call copy3_scalar(c_aptr, c_bptr) + !$omp target update from(bb) + if (abs(aa - 1111.0_c_float) > 10.0_c_float * epsilon(aa)) call abort() + if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort() + + ! check Fortran pointer after target-value modification + aa = 11111.0_c_float + !$omp target update to(aa) + call copy3_scalar(c_loc(aptr), c_loc(bptr)) + !$omp target update from(bb) + if (abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa)) call abort() + if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort() + !$omp end target data + + if (abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa)) call abort() + if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort() + + + !$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)) call abort() + if (.not.c_associated(c_loc(cc)) .or. .not.c_associated(c_loc(dd))) call abort() + 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)) call abort() + if (.not.associated(cptr) .or. .not.associated(dptr)) call abort() + !$omp end target data + if (.not.present(cc) .or. .not.present(dd)) call abort() + if (.not.c_associated(c_loc(cc)) .or. .not.c_associated(c_loc(dd))) call abort() + if (.not.c_associated(c_cptr) .or. .not.c_associated(c_dptr)) call abort() + if (.not.associated(cptr) .or. .not.associated(dptr)) call abort() + + ! check c_loc ptr once + call copy3_scalar(c_cptr, c_dptr) + !$omp target update from(dd) + if (abs(cc - 333.0_c_float) > 10.0_c_float * epsilon(cc)) call abort() + if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) call abort() + + ! check c_loc ptr again after target-value modification + cc = 3333.0_c_float + !$omp target update to(cc) + call copy3_scalar(c_cptr, c_dptr) + !$omp target update from(dd) + if (abs(cc - 3333.0_c_float) > 10.0_c_float * epsilon(cc)) call abort() + if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) call abort() + + ! check Fortran pointer after target-value modification + cc = 33333.0_c_float + !$omp target update to(cc) + call copy3_scalar(c_loc(cptr), c_loc(dptr)) + !$omp target update from(dd) + if (abs(cc - 33333.0_c_float) > 10.0_c_float * epsilon(cc)) call abort() + if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) call abort() + !$omp end target data + + if (abs(cc - 33333.0_c_float) > 10.0_c_float * epsilon(dd)) call abort() + if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(dd)) call abort() + + + !$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)) call abort() + if (.not.associated(ee) .or. .not.associated(ff)) call abort() + if (.not.c_associated(c_loc(ee)) .or. .not.c_associated(c_loc(ff))) call abort() + 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)) call abort() + if (.not.associated(eptr) .or. .not.associated(fptr)) call abort() + !$omp end target data + if (.not.present(ee) .or. .not.present(ff)) call abort() + if (.not.associated(ee) .or. .not.associated(ff)) call abort() + if (.not.c_associated(c_loc(ee)) .or. .not.c_associated(c_loc(ff))) call abort() + if (.not.c_associated(c_eptr) .or. .not.c_associated(c_fptr)) call abort() + if (.not.associated(eptr) .or. .not.associated(fptr)) call abort() + + ! check c_loc ptr once + call copy3_scalar(c_eptr, c_fptr) + !$omp target update from(ff) + if (abs(ee - 555.0_c_float) > 10.0_c_float * epsilon(ee)) call abort() + if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) call abort() + + ! check c_loc ptr again after target-value modification + ee = 5555.0_c_float + !$omp target update to(ee) + call copy3_scalar(c_eptr, c_fptr) + !$omp target update from(ff) + if (abs(ee - 5555.0_c_float) > 10.0_c_float * epsilon(ee)) call abort() + if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) call abort() + + ! check Fortran pointer after target-value modification + ee = 55555.0_c_float + !$omp target update to(ee) + call copy3_scalar(c_loc(eptr), c_loc(fptr)) + !$omp target update from(ff) + if (abs(ee - 55555.0_c_float) > 10.0_c_float * epsilon(ee)) call abort() + if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ff)) call abort() + !$omp end target data + + if (abs(ee - 55555.0_c_float) > 10.0_c_float * epsilon(ee)) call abort() + if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) call abort() + + + !$omp target data map(to:gg) map(from:hh) + !$omp target data map(alloc:dummy) use_device_addr(gg,hh) + if (.not.present(gg) .or. .not.present(hh)) call abort() + if (.not.c_associated(c_loc(gg)) .or. .not.c_associated(c_loc(hh))) call abort() + c_gptr = c_loc(gg) + c_hptr = c_loc(hh) + gptr => gg + hptr => hh + if (.not.c_associated(c_gptr) .or. .not.c_associated(c_hptr)) call abort() + if (.not.associated(gptr) .or. .not.associated(hptr)) call abort() + !$omp end target data + if (.not.present(gg) .or. .not.present(hh)) call abort() + if (.not.c_associated(c_loc(gg)) .or. .not.c_associated(c_loc(hh))) call abort() + if (.not.c_associated(c_gptr) .or. .not.c_associated(c_hptr)) call abort() + if (.not.associated(gptr) .or. .not.associated(hptr)) call abort() + + ! check c_loc ptr once + call copy3_array(c_gptr, c_hptr, N) + !$omp target update from(hh) + if (any(abs(gg - 777.0_c_float) > 10.0_c_float * epsilon(gg))) call abort() + if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(hh))) call abort() + + ! check c_loc ptr again after target-value modification + gg = 7777.0_c_float + !$omp target update to(gg) + call copy3_array(c_gptr, c_hptr, N) + !$omp target update from(hh) + if (any(abs(gg - 7777.0_c_float) > 10.0_c_float * epsilon(gg))) call abort() + if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) call abort() + + ! check Fortran pointer after target-value modification + gg = 77777.0_c_float + !$omp target update to(gg) + call copy3_array(c_loc(gptr), c_loc(hptr), N) + !$omp target update from(hh) + if (any(abs(gg - 77777.0_c_float) > 10.0_c_float * epsilon(gg))) call abort() + if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) call abort() + !$omp end target data + + if (any(abs(gg - 77777.0_c_float) > 10.0_c_float * epsilon(gg))) call abort() + if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) call abort() + end subroutine test_dummy_opt_callee_2 +end module test_dummies_opt + + + +! Test local dummy arguments + OPTIONAL + VALUE +! Values present +module test_dummies_opt_value + use iso_c_binding + use target_procs + implicit none + private + public :: test_dummy_opt_val_call_1, test_dummy_opt_val_call_2 +contains + subroutine test_dummy_opt_val_call_1() + ! scalars - with value, neither allocatable nor pointer no dimension permitted + real(c_float), target :: aa, bb + + aa = 11.0_c_float + bb = 22.0_c_float + + call test_dummy_opt_val_callee_1(aa, bb) + end subroutine test_dummy_opt_val_call_1 + + subroutine test_dummy_opt_val_callee_1(aa, bb) + ! scalars + real(c_float), optional, value, target :: aa, bb + + if (.not.present(aa) .or. .not.present(bb)) call abort() + + !$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb) + if (.not.present(aa) .or. .not.present(bb)) call abort() + if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) call abort() + call copy3_scalar(c_loc(aa), c_loc(bb)) + !$omp end target data + if (abs(aa - 11.0_c_float) > 10.0_c_float * epsilon(aa)) call abort() + if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort() + end subroutine test_dummy_opt_val_callee_1 + + ! Save device ptr - and recall pointer + subroutine test_dummy_opt_val_call_2() + ! scalars - with value, neither allocatable nor pointer no dimension permitted + real(c_float), target :: aa, bb + type(c_ptr) :: c_aptr, c_bptr + real(c_float), pointer :: aptr, bptr + + call test_dummy_opt_val_callee_2(aa, bb, c_aptr, c_bptr, aptr, bptr) + end subroutine test_dummy_opt_val_call_2 + + subroutine test_dummy_opt_val_callee_2(aa, bb, c_aptr, c_bptr, aptr, bptr) + real(c_float), optional, value, target :: aa, bb + type(c_ptr), optional, value :: c_aptr, c_bptr + real(c_float), optional, pointer :: aptr, bptr + + real(c_float) :: dummy + + if (.not.present(aa) .or. .not.present(bb)) call abort() + if (.not.present(c_aptr) .or. .not.present(c_bptr)) call abort() + if (.not.present(aptr) .or. .not.present(bptr)) call abort() + + aa = 111.0_c_float + bb = 222.0_c_float + + !$omp target data map(to:aa) map(from:bb) + if (.not.present(aa) .or. .not.present(bb)) call abort() + if (.not.present(c_aptr) .or. .not.present(c_bptr)) call abort() + if (.not.present(aptr) .or. .not.present(bptr)) call abort() + + !$omp target data map(alloc:dummy) use_device_addr(aa,bb) + if (.not.present(aa) .or. .not.present(bb)) call abort() + if (.not.present(c_aptr) .or. .not.present(c_bptr)) call abort() + if (.not.present(aptr) .or. .not.present(bptr)) call abort() + + 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)) call abort() + if (.not.associated(aptr) .or. .not.associated(bptr)) call abort() + !$omp end target data + + ! check c_loc ptr once + call copy3_scalar(c_aptr, c_bptr) + !$omp target update from(bb) + if (abs(aa - 111.0_c_float) > 10.0_c_float * epsilon(aa)) call abort() + if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort() + + ! check c_loc ptr again after target-value modification + aa = 1111.0_c_float + !$omp target update to(aa) + call copy3_scalar(c_aptr, c_bptr) + !$omp target update from(bb) + if (abs(aa - 1111.0_c_float) > 10.0_c_float * epsilon(aa)) call abort() + if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort() + + ! check Fortran pointer after target-value modification + aa = 11111.0_c_float + !$omp target update to(aa) + call copy3_scalar(c_loc(aptr), c_loc(bptr)) + !$omp target update from(bb) + if (abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa)) call abort() + if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort() + !$omp end target data + + if (abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa)) call abort() + if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort() + end subroutine test_dummy_opt_val_callee_2 +end module test_dummies_opt_value + + + +! Test nullptr +module test_nullptr + use iso_c_binding + implicit none + private + public :: test_nullptr_1 +contains + subroutine test_nullptr_1() + ! scalars + real(c_float), pointer :: aa, bb + real(c_float), pointer :: ee, ff + + type(c_ptr) :: c_aptr, c_bptr, c_eptr, c_fptr + real(c_float), pointer :: aptr, bptr, eptr, fptr + + aa => null() + bb => null() + ee => null() + ff => null() + + if (associated(aa) .or. associated(bb)) call abort() + !$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))) call abort() + c_aptr = c_loc(aa) + c_bptr = c_loc(bb) + aptr => aa + bptr => bb + if (c_associated(c_aptr) .or. c_associated(c_bptr)) call abort() + if (associated(aptr) .or. associated(bptr, bb)) call abort() + !$omp end target data + if (c_associated(c_aptr) .or. c_associated(c_bptr)) call abort() + if (associated(aptr) .or. associated(bptr, bb)) call abort() + + call test_dummy_opt_nullptr_callee_1(ee, ff, c_eptr, c_fptr, eptr, fptr) + end subroutine test_nullptr_1 + + subroutine test_dummy_opt_nullptr_callee_1(ee, ff, c_eptr, c_fptr, eptr, fptr) + ! scalars + real(c_float), optional, pointer :: ee, ff + + type(c_ptr), optional :: c_eptr, c_fptr + real(c_float), optional, pointer :: eptr, fptr + + if (.not.present(ee) .or. .not.present(ff)) call abort() + if (associated(ee) .or. associated(ff)) call abort() + + !$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff) + if (.not.present(ee) .or. .not.present(ff)) call abort() + if (associated(ee) .or. associated(ff)) call abort() + if (c_associated(c_loc(ee)) .or. c_associated(c_loc(ff))) call abort() + c_eptr = c_loc(ee) + c_fptr = c_loc(ff) + eptr => ee + fptr => ff + if (c_associated(c_eptr) .or. c_associated(c_fptr)) call abort() + if (associated(eptr) .or. associated(fptr)) call abort() + !$omp end target data + + if (c_associated(c_eptr) .or. c_associated(c_fptr)) call abort() + if (associated(eptr) .or. associated(fptr)) call abort() + 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 + private + public :: test_main_1, test_main_2 +contains + ! map + use_device_addr + c_loc + subroutine test_main_1() + integer, parameter :: N = 1000 + + ! scalars + real(c_float), target :: aa, bb + real(c_float), target, allocatable :: cc, dd + real(c_float), pointer :: ee, ff + + ! non-descriptor arrays + real(c_float), target :: gg(N), hh(N) + + allocate(cc, dd, ee, ff) + + + aa = 11.0_c_float + bb = 22.0_c_float + cc = 33.0_c_float + dd = 44.0_c_float + ee = 55.0_c_float + ff = 66.0_c_float + gg = 77.0_c_float + hh = 88.0_c_float + + !$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb) + call copy3_scalar(c_loc(aa), c_loc(bb)) + !$omp end target data + if (abs(aa - 11.0_c_float) > 10.0_c_float * epsilon(aa)) call abort() + if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort() + + !$omp target data map(to:cc) map(from:dd) use_device_addr(cc,dd) + call copy3_scalar(c_loc(cc), c_loc(dd)) + !$omp end target data + if (abs(cc - 33.0_c_float) > 10.0_c_float * epsilon(cc)) call abort() + if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) call abort() + + !$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff) + call copy3_scalar(c_loc(ee), c_loc(ff)) + !$omp end target data + if (abs(ee - 55.0_c_float) > 10.0_c_float * epsilon(ee)) call abort() + if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) call abort() + + + !$omp target data map(to:gg) map(from:hh) use_device_addr(gg,hh) + call copy3_array(c_loc(gg), c_loc(hh), N) + !$omp end target data + if (any(abs(gg - 77.0_c_float) > 10.0_c_float * epsilon(gg))) call abort() + if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) call abort() + + deallocate(ee, ff) ! pointers, only + end subroutine test_main_1 + + ! Save device ptr - and recall pointer + subroutine test_main_2 + integer, parameter :: N = 1000 + + ! scalars + real(c_float), target :: aa, bb + real(c_float), target, allocatable :: cc, dd + real(c_float), pointer :: ee, ff + + ! non-descriptor arrays + real(c_float), target :: gg(N), hh(N) + + real(c_float) :: dummy + type(c_ptr) :: c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, c_gptr, c_hptr + real(c_float), pointer :: aptr, bptr, cptr, dptr, eptr, fptr + real(c_float), pointer :: gptr(:), hptr(:) + + allocate(cc, dd, ee, ff) + + aa = 111.0_c_float + bb = 222.0_c_float + cc = 333.0_c_float + dd = 444.0_c_float + ee = 555.0_c_float + ff = 666.0_c_float + gg = 777.0_c_float + hh = 888.0_c_float + + !$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_scalar(c_aptr, c_bptr) + !$omp target update from(bb) + if (abs(aa - 111.0_c_float) > 10.0_c_float * epsilon(aa)) call abort() + if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort() + + ! check c_loc ptr again after target-value modification + aa = 1111.0_c_float + !$omp target update to(aa) + call copy3_scalar(c_aptr, c_bptr) + !$omp target update from(bb) + if (abs(aa - 1111.0_c_float) > 10.0_c_float * epsilon(aa)) call abort() + if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort() + + ! check Fortran pointer after target-value modification + aa = 11111.0_c_float + !$omp target update to(aa) + call copy3_scalar(c_loc(aptr), c_loc(bptr)) + !$omp target update from(bb) + if (abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa)) call abort() + if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort() + !$omp end target data + + if (abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa)) call abort() + if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort() + + + !$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_scalar(c_cptr, c_dptr) + !$omp target update from(dd) + if (abs(cc - 333.0_c_float) > 10.0_c_float * epsilon(cc)) call abort() + if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) call abort() + + ! check c_loc ptr again after target-value modification + cc = 3333.0_c_float + !$omp target update to(cc) + call copy3_scalar(c_cptr, c_dptr) + !$omp target update from(dd) + if (abs(cc - 3333.0_c_float) > 10.0_c_float * epsilon(cc)) call abort() + if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) call abort() + + ! check Fortran pointer after target-value modification + cc = 33333.0_c_float + !$omp target update to(cc) + call copy3_scalar(c_loc(cptr), c_loc(dptr)) + !$omp target update from(dd) + if (abs(cc - 33333.0_c_float) > 10.0_c_float * epsilon(cc)) call abort() + if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) call abort() + !$omp end target data + + if (abs(cc - 33333.0_c_float) > 10.0_c_float * epsilon(dd)) call abort() + if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(dd)) call abort() + + + !$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_scalar(c_eptr, c_fptr) + !$omp target update from(ff) + if (abs(ee - 555.0_c_float) > 10.0_c_float * epsilon(ee)) call abort() + if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) call abort() + + ! check c_loc ptr again after target-value modification + ee = 5555.0_c_float + !$omp target update to(ee) + call copy3_scalar(c_eptr, c_fptr) + !$omp target update from(ff) + if (abs(ee - 5555.0_c_float) > 10.0_c_float * epsilon(ee)) call abort() + if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) call abort() + + ! check Fortran pointer after target-value modification + ee = 55555.0_c_float + !$omp target update to(ee) + call copy3_scalar(c_loc(eptr), c_loc(fptr)) + !$omp target update from(ff) + if (abs(ee - 55555.0_c_float) > 10.0_c_float * epsilon(ee)) call abort() + if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ff)) call abort() + !$omp end target data + + if (abs(ee - 55555.0_c_float) > 10.0_c_float * epsilon(ee)) call abort() + if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) call abort() + + + !$omp target data map(to:gg) map(from:hh) + !$omp target data map(alloc:dummy) use_device_addr(gg,hh) + c_gptr = c_loc(gg) + c_hptr = c_loc(hh) + gptr => gg + hptr => hh + !$omp end target data + + ! check c_loc ptr once + call copy3_array(c_gptr, c_hptr, N) + !$omp target update from(hh) + if (any(abs(gg - 777.0_c_float) > 10.0_c_float * epsilon(gg))) call abort() + if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(hh))) call abort() + + ! check c_loc ptr again after target-value modification + gg = 7777.0_c_float + !$omp target update to(gg) + call copy3_array(c_gptr, c_hptr, N) + !$omp target update from(hh) + if (any(abs(gg - 7777.0_c_float) > 10.0_c_float * epsilon(gg))) call abort() + if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) call abort() + + ! check Fortran pointer after target-value modification + gg = 77777.0_c_float + !$omp target update to(gg) + call copy3_array(c_loc(gptr), c_loc(hptr), N) + !$omp target update from(hh) + if (any(abs(gg - 77777.0_c_float) > 10.0_c_float * epsilon(gg))) call abort() + if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) call abort() + !$omp end target data + + if (any(abs(gg - 77777.0_c_float) > 10.0_c_float * epsilon(gg))) call abort() + if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) call abort() + + deallocate(ee, ff) + end subroutine test_main_2 +end module tests + + +program omp_device_addr + use tests + use test_dummies + use test_dummies_value + use test_dummies_opt + use test_dummies_opt_value + use test_nullptr + implicit none + + call test_main_1() + call test_main_2() + + call test_dummy_call_1() + call test_dummy_call_2() + + call test_dummy_val_call_1() + call test_dummy_val_call_2() + + call test_dummy_opt_call_1() + call test_dummy_opt_call_2() + + call test_dummy_opt_val_call_1() + call test_dummy_opt_val_call_2() + + call test_nullptr_1() +end program omp_device_addr

[OpenMP,Fortran] Fix several OpenMP use_device_addr/map/update errors found by a length test case

Commit Message

Comments

Patch