+2019-10-09 Tobias Burnus <tobias@codesourcery.com>
+
+ * f95-lang.c (LANG_HOOKS_OMP_ARRAY_DATA): Set to gfc_omp_array_data.
+ * trans-array.c (gfc_conv_descriptor_data_get): Handle ref types.
+ * trans-openmp.c (gfc_omp_array_data): New.
+ * trans.h (gfc_omp_array_data): Declare.
+
2019-09-20 Julian Brown <julian@codesourcery.com>
* gimplify.c (localize_reductions): Rewrite references for
+2019-10-09 Tobias Burnus <tobias@codesourcery.com>
+
+ * hooks.c (hook_tree_tree_null): New.
+ * hooks.h (hook_tree_tree_null): Declare.
+ * langhooks-def.h (LANG_HOOKS_OMP_ARRAY_DATA): Define.
+ (LANG_HOOKS_FOR_TYPES_INITIALIZER): Use it.
+ * langhooks.h (lang_hooks_for_types): Add omp_array_data.
+ * omp-general.c (omp_is_optional_argument): Handle value+optional.
+ * omp-low.c (omp_context): Add array_data_map + present_map.
+ (install_var_field): Handle array descriptors.
+ (delete_omp_context): Free new maps.
+ (scan_sharing_clauses): Handle array descriptors.
+ (lower_omp_target): Ditto. Fix optional-arg present check.
+
2019-10-08 Tobias Burnus <tobias@codesourcery.com>
Backported from mainline
#undef LANG_HOOKS_MARK_ADDRESSABLE
#undef LANG_HOOKS_TYPE_FOR_MODE
#undef LANG_HOOKS_TYPE_FOR_SIZE
+#undef LANG_HOOKS_OMP_ARRAY_DATA
#undef LANG_HOOKS_INIT_TS
#undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE
#undef LANG_HOOKS_OMP_PREDETERMINED_SHARING
#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_ARRAY_DATA gfc_omp_array_data
#define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE gfc_omp_privatize_by_reference
#define LANG_HOOKS_OMP_PREDETERMINED_SHARING gfc_omp_predetermined_sharing
#define LANG_HOOKS_OMP_REPORT_DECL gfc_omp_report_decl
tree field, type, t;
type = TREE_TYPE (desc);
+ if (TREE_CODE (type) == REFERENCE_TYPE)
+ type = TREE_TYPE (type);
+
gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
field = TYPE_FIELDS (type);
int ompws_flags;
+tree
+gfc_omp_array_data (tree decl)
+{
+ tree type = TREE_TYPE (decl);
+
+ if (TREE_CODE (type) == REFERENCE_TYPE || POINTER_TYPE_P (type))
+ type = TREE_TYPE (type);
+
+ if (!GFC_DESCRIPTOR_TYPE_P (type))
+ return NULL_TREE;
+
+ if (POINTER_TYPE_P (TREE_TYPE (decl)))
+ decl = build_fold_indirect_ref (decl);
+
+ decl = gfc_conv_descriptor_data_get (decl);
+ STRIP_NOPS (decl);
+ return decl;
+}
+
/* True if OpenMP should privatize what this DECL points to rather
than the DECL itself. */
bool gfc_get_array_descr_info (const_tree, struct array_descr_info *);
/* In trans-openmp.c */
+tree gfc_omp_array_data (tree);
bool gfc_omp_privatize_by_reference (const_tree);
enum omp_clause_default_kind gfc_omp_predetermined_sharing (tree);
tree gfc_omp_report_decl (tree);
return NULL;
}
+tree
+hook_tree_tree_null (tree)
+{
+ return NULL;
+}
+
tree
hook_tree_tree_tree_null (tree, tree)
{
extern tree hook_tree_const_tree_null (const_tree);
extern tree hook_tree_void_null (void);
+extern tree hook_tree_tree_null (tree);
extern tree hook_tree_tree_tree_null (tree, tree);
extern tree hook_tree_tree_tree_tree_null (tree, tree, tree);
extern tree hook_tree_tree_int_treep_bool_null (tree, int, tree *, bool);
#define LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES \
lhd_omp_firstprivatize_type_sizes
#define LANG_HOOKS_OMP_MAPPABLE_TYPE lhd_omp_mappable_type
+#define LANG_HOOKS_OMP_ARRAY_DATA hook_tree_tree_null
#define LANG_HOOKS_TYPE_HASH_EQ NULL
#define LANG_HOOKS_COPY_LANG_QUALIFIERS NULL
#define LANG_HOOKS_GET_ARRAY_DESCR_INFO NULL
LANG_HOOKS_TYPE_MAX_SIZE, \
LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES, \
LANG_HOOKS_OMP_MAPPABLE_TYPE, \
+ LANG_HOOKS_OMP_ARRAY_DATA, \
LANG_HOOKS_TYPE_HASH_EQ, \
LANG_HOOKS_COPY_LANG_QUALIFIERS, \
LANG_HOOKS_GET_ARRAY_DESCR_INFO, \
/* Return true if TYPE is a mappable type. */
bool (*omp_mappable_type) (tree type);
+ /* Return a tree for of the actual data of an array descriptor - or
+ NULL_TREE if original tree is not an array descriptor. */
+ tree (*omp_array_data) (tree);
+
/* Return TRUE if TYPE1 and TYPE2 are identical for type hashing purposes.
Called only after doing all language independent checks.
At present, this function is only called when both TYPE1 and TYPE2 are
{
/* A passed-by-reference Fortran optional argument is similar to
a normal argument, but since it can be null the type is a
- POINTER_TYPE rather than a REFERENCE_TYPE. */
+ POINTER_TYPE rather than a REFERENCE_TYPE. However, for
+ optional + value, de-referencing gives 'void' which is invalid. */
return lang_GNU_Fortran ()
- && TREE_CODE (decl) == PARM_DECL
- && DECL_BY_REFERENCE (decl)
- && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE;
+ && TREE_CODE (decl) == PARM_DECL
+ && DECL_BY_REFERENCE (decl)
+ && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE
+ && !VOID_TYPE_P (TREE_TYPE (TREE_TYPE (decl)));
}
/* Return true if DECL is a reference type. */
/* Map variables to fields in a structure that allows communication
between sending and receiving threads. */
splay_tree field_map;
+ splay_tree array_data_map;
+ splay_tree present_map;
splay_tree parm_map;
tree record_type;
tree sender_decl;
tree field, type, sfield = NULL_TREE;
splay_tree_key key = (splay_tree_key) var;
- if ((mask & 8) != 0)
+ if ((mask & 16) != 0)
+ key = (splay_tree_key) var;
+ else if ((mask & 8) != 0)
{
key = (splay_tree_key) &DECL_UID (var);
gcc_checking_assert (key != (splay_tree_key) var);
else if ((mask & 3) == 1 && omp_is_reference (var))
type = TREE_TYPE (type);
- field = build_decl (DECL_SOURCE_LOCATION (var),
- FIELD_DECL, DECL_NAME (var), type);
+ if ((mask & 16) != 0)
+ field = build_decl (UNKNOWN_LOCATION, FIELD_DECL, NULL_TREE, type);
+ else
+ field = build_decl (DECL_SOURCE_LOCATION (var),
+ FIELD_DECL, DECL_NAME (var), type);
/* Remember what variable this field was created for. This does have a
side effect of making dwarf2out ignore this member, so for helpful
debugging we clear it later in delete_omp_context. */
DECL_ABSTRACT_ORIGIN (field) = var;
- if (type == TREE_TYPE (var))
+ if ((mask & 16) == 0 && type == TREE_TYPE (var))
{
SET_DECL_ALIGN (field, DECL_ALIGN (var));
DECL_USER_ALIGN (field) = DECL_USER_ALIGN (var);
splay_tree_delete (ctx->field_map);
if (ctx->sfield_map)
splay_tree_delete (ctx->sfield_map);
+ if (ctx->array_data_map)
+ splay_tree_delete (ctx->array_data_map);
+ if (ctx->present_map)
+ splay_tree_delete (ctx->present_map);
if (ctx->parm_map)
splay_tree_delete (ctx->parm_map);
scan_sharing_clauses (tree clauses, omp_context *ctx,
bool base_pointers_restrict = false)
{
- tree c, decl;
+ tree c, decl, x;
bool scan_array_reductions = false;
for (c = clauses; c; c = OMP_CLAUSE_CHAIN (c))
case OMP_CLAUSE_USE_DEVICE_PTR:
decl = OMP_CLAUSE_DECL (c);
- if (TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE)
+ x = NULL;
+ // Handle array descriptors
+ if (TREE_CODE (TREE_TYPE (decl)) == RECORD_TYPE ||
+ (omp_is_reference (decl)
+ && TREE_CODE (TREE_TYPE (TREE_TYPE (decl))) == RECORD_TYPE))
+ x = lang_hooks.types.omp_array_data (decl);
+
+ if (x)
+ {
+ gcc_assert (!ctx->array_data_map
+ || !splay_tree_lookup (ctx->array_data_map,
+ (splay_tree_key) decl));
+ if (!ctx->array_data_map)
+ ctx->array_data_map
+ = splay_tree_new (splay_tree_compare_pointers, 0, 0);
+
+ splay_tree_insert (ctx->array_data_map, (splay_tree_key) decl,
+ (splay_tree_value) x);
+
+ install_var_field (x, false, 19, ctx);
+ DECL_SOURCE_LOCATION (lookup_field (x, ctx))
+ = OMP_CLAUSE_LOCATION (c);
+ }
+ else if (TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE)
install_var_field (decl, true, 3, ctx);
else
install_var_field (decl, false, 3, ctx);
case OMP_CLAUSE_IS_DEVICE_PTR:
ovar = OMP_CLAUSE_DECL (c);
var = lookup_decl_in_outer_ctx (ovar, ctx);
- x = build_sender_ref (ovar, ctx);
+
+ // For arrays with descriptor, use the pointer to the actual data
+ splay_tree_node n = ctx->array_data_map
+ ? splay_tree_lookup (ctx->array_data_map,
+ (splay_tree_key) ovar)
+ : NULL;
+ if (n)
+ x = build_sender_ref ((tree) n->value, ctx);
+ else
+ x = build_sender_ref (ovar, ctx);
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_PTR)
tkind = GOMP_MAP_USE_DEVICE_PTR;
else
tkind = GOMP_MAP_FIRSTPRIVATE_INT;
type = TREE_TYPE (ovar);
- if (TREE_CODE (type) == ARRAY_TYPE)
+ if (n)
+ {
+ var = (tree) n->value;
+ gimplify_assign (x, var, &ilist);
+ }
+ else if (TREE_CODE (type) == ARRAY_TYPE)
{
var = build_fold_addr_expr (var);
gimplify_assign (x, var, &ilist);
= create_artificial_label (UNKNOWN_LOCATION);
opt_arg_label
= create_artificial_label (UNKNOWN_LOCATION);
+
+ tree present = create_tmp_var_raw (boolean_type_node,
+ get_name (var));
+ tree cond2 = fold_build2 (NE_EXPR, boolean_type_node,
+ var, null_pointer_node);
+ if (!ctx->present_map)
+ ctx->present_map
+ = splay_tree_new (splay_tree_compare_pointers, 0, 0);
+
+ splay_tree_insert (ctx->present_map, (splay_tree_key) var,
+ (splay_tree_value) present);
+
tree new_x = copy_node (x);
- gcond *cond = gimple_build_cond (EQ_EXPR, ovar,
- null_pointer_node,
- null_label,
- notnull_label);
+ gcond *cond = gimple_build_cond_from_tree (present,
+ notnull_label,
+ null_label);
+ gimple_add_tmp_var (present);
+ gimplify_assign (present, cond2, &ilist);
gimple_seq_add_stmt (&ilist, cond);
gimple_seq_add_stmt (&ilist,
gimple_build_label (null_label));
case OMP_CLAUSE_USE_DEVICE_PTR:
case OMP_CLAUSE_IS_DEVICE_PTR:
var = OMP_CLAUSE_DECL (c);
+ tree array_data = NULL;
+ if (ctx->array_data_map)
+ {
+ splay_tree_node n = splay_tree_lookup (ctx->array_data_map,
+ (splay_tree_key) var);
+ if (n)
+ array_data = (tree) n->value;
+ }
+
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_PTR)
- x = build_sender_ref (var, ctx);
+ x = build_sender_ref (array_data ? array_data : var, ctx);
else
- x = build_receiver_ref (var, false, ctx);
- if (is_variable_sized (var))
+ x = build_receiver_ref (array_data ? array_data : var, false, ctx);
+ if (array_data)
+ {
+ tree new_var = lookup_decl (var, ctx);
+ new_var = DECL_VALUE_EXPR (new_var);
+ if (omp_is_reference (var))
+ {
+ tree type = TREE_TYPE (TREE_TYPE (var));
+ tree v = create_tmp_var_raw (type, get_name (var));
+ gimple_add_tmp_var (v);
+ TREE_ADDRESSABLE (v) = 1;
+ tree x2 = build_fold_indirect_ref (var);
+ gimplify_expr (&x2, &new_body, NULL, is_gimple_val, fb_rvalue);
+ gimple_seq_add_stmt (&new_body, gimple_build_assign (v, x2));
+
+ tree v2 = lang_hooks.types.omp_array_data (v);
+ gcc_assert (v2);
+ gimplify_expr (&x, &new_body, NULL, is_gimple_val, fb_rvalue);
+ gimple_seq_add_stmt (&new_body,
+ gimple_build_assign (v2, x));
+ x = build_fold_addr_expr (v);
+ gimple_seq_add_stmt (&new_body,
+ gimple_build_assign (new_var, x));
+ }
+ else
+ {
+ gimple_seq_add_stmt (&new_body,
+ gimple_build_assign (new_var, var));
+ new_var = lang_hooks.types.omp_array_data (new_var);
+ gcc_assert (new_var);
+ gimplify_expr (&x, &new_body, NULL, is_gimple_val, fb_rvalue);
+ gimple_seq_add_stmt (&new_body,
+ gimple_build_assign (new_var, x));
+ }
+ }
+ else if (is_variable_sized (var))
{
tree pvar = DECL_VALUE_EXPR (var);
gcc_assert (TREE_CODE (pvar) == INDIRECT_REF);
gimplify_expr (&x, &new_body, NULL, is_gimple_val,
fb_rvalue);
- cond = gimple_build_cond (EQ_EXPR, x,
- null_pointer_node,
- null_label,
- notnull_label);
+ splay_tree_node n_present
+ = splay_tree_lookup (ctx->present_map,
+ (splay_tree_key) var);
+ cond = gimple_build_cond_from_tree (
+ (tree) n_present->value,
+ notnull_label, null_label);
gimple_seq_add_stmt (&new_body, cond);
gimple_seq_add_stmt (&new_body, null_glabel);
gimplify_assign (new_var, null_pointer_node,
+2019-10-09 Tobias Burnus <tobias@codesourcery.com>
+
+ * gfortran.dg/gomp/use_device_ptr1.f90: New.
+ * gfortran.dg/gomp/use_device_ptr2.f90: New.
+ * gfortran.dg/gomp/use_device_ptr3.f90: New.
+
2019-10-08 Tobias Burnus <tobias@codesourcery.com>
Backported from mainline
--- /dev/null
+! { dg-do compile }
+! { dg-options "-fopenmp -fdump-tree-optimized -O0" }
+
+! Check use_device_ptr with local variables
+
+module offloading
+ use iso_c_binding
+ implicit none
+ interface
+ subroutine copy3_array_data(from, to, N) bind(C)
+ import :: c_ptr
+ type(c_ptr), value :: from, to
+ integer, value :: N
+ end subroutine copy3_array_data
+ end interface
+end module offloading
+
+subroutine omp_device_ptr()
+ use iso_c_binding
+ use offloading
+ implicit none
+
+ integer, parameter :: N = 1000
+ real(c_double), pointer :: AA(:), BBB(:)
+ real(c_double), allocatable, target :: CC(:), DD(:)
+ real(c_double), target :: EE(N), FF(N), dummy(1)
+
+ ! allocate(AA(N), BBB(N), CC(N), DD(N)) ! make dump more readable
+
+ ! AA = 11.0_c_double
+ ! BBB = 22.0_c_double
+ ! CC = 33.0_c_double
+ ! DD = 44.0_c_double
+ ! EE = 55.0_c_double
+ ! FF = 66.0_c_double
+
+ ! NOTE: OpenMP 5's use_device_addr is (at time of writing) not yet supported
+
+ ! pointer-type array to use_device_ptr
+ ! !$omp target data map(to:AA) map(from:BBB) use_device_ptr(AA,BBB)
+ !$omp target data map(alloc:dummy) use_device_ptr(AA,BBB)
+ call copy3_array_data(c_loc(AA), c_loc(BBB), N)
+ !$omp end target data
+
+ ! allocatable array to use_device_ptr
+ !!$omp target data map(to:CC) map(from:DD) use_device_ptr(CC,DD)
+ !$omp target data map(alloc:dummy) use_device_ptr(CC,DD)
+ call copy3_array_data(c_loc(CC), c_loc(DD), N)
+ !$omp end target data
+
+ ! fixed-size decriptorless array to use_device_ptr
+ !!$omp target data map(to:EE) map(from:FF) use_device_ptr(EE,FF)
+ !$omp target data map(alloc:dummy) use_device_ptr(EE,FF)
+ call copy3_array_data(c_loc(EE), c_loc(FF), N)
+ !$omp end target data
+
+ ! deallocate(AA, BBB) ! Free all pointers, only
+end subroutine omp_device_ptr
+
+
+! { dg-final { scan-tree-dump-not ".omp_data_arr.\[0-9\]+.aa = &aa" "optimized" } }
+! { dg-final { scan-tree-dump-not ".omp_data_arr.\[0-9\]+.aa = aa" "optimized" } }
+! { dg-final { scan-tree-dump-not ".omp_data_arr.\[0-9\]+.bbb = &bbb" "optimized" } }
+! { dg-final { scan-tree-dump-not ".omp_data_arr.\[0-9\]+.bbb = bbb" "optimized" } }
+! { dg-final { scan-tree-dump-not ".omp_data_arr.\[0-9\]+.cc = &cc" "optimized" } }
+! { dg-final { scan-tree-dump-not ".omp_data_arr.\[0-9\]+.cc = cc" "optimized" } }
+! { dg-final { scan-tree-dump-not ".omp_data_arr.\[0-9\]+.dd = &dd" "optimized" } }
+! { dg-final { scan-tree-dump-not ".omp_data_arr.\[0-9\]+.dd = dd" "optimized" } }
+! { dg-final { scan-tree-dump-not ".omp_data_arr.\[0-9\]+.ee = ee" "optimized" } }
+! { dg-final { scan-tree-dump-not ".omp_data_arr.\[0-9\]+.ff = ff" "optimized" } }
+! { dg-final { scan-tree-dump-times ".omp_data_arr.\[0-9\]+.ee = &ee" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times ".omp_data_arr.\[0-9\]+.ff = &ff" 1 "optimized" } }
+
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = aa.data;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "aa\.\[0-9\]+ = aa;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "aa\.\[0-9\]+\.data = _\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = aa\.\[0-9\]+\.data;" 1 "optimized" } }
+
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = bbb.data;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "bbb\.\[0-9\]+ = bbb;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "bbb\.\[0-9\]+\.data = _\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = bbb\.\[0-9\]+\.data;" 1 "optimized" } }
+
+! '3' because of automatic deallocation
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = cc.data;" 3 "optimized" } }
+! { dg-final { scan-tree-dump-times "cc\.\[0-9\]+ = cc;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "cc\.\[0-9\]+\.data = _\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = cc\.\[0-9\]+\.data;" 1 "optimized" } }
+
+! '3' because of automatic deallocation
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = dd.data;" 3 "optimized" } }
+! { dg-final { scan-tree-dump-times "dd\.\[0-9\]+ = dd;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "dd\.\[0-9\]+\.data = _\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = dd\.\[0-9\]+\.data;" 1 "optimized" } }
+
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = .omp_data_arr.\[0-9\]+.ee;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "ee\.\[0-9\]+_\[0-9\]+ = _\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = &\\*ee.\[0-9\]+_\[0-9\]+;" 1 "optimized" } }
+
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = .omp_data_arr.\[0-9\]+.ff;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "ff\.\[0-9\]+_\[0-9\]+ = _\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = &\\*ff.\[0-9\]+_\[0-9\]+;" 1 "optimized" } }
--- /dev/null
+! { dg-do compile }
+! { dg-options "-fopenmp -fdump-tree-optimized -O0" }
+
+! Check use_device_ptr with nonoptional dummy arguments
+
+module offloading
+ use iso_c_binding
+ implicit none
+ interface
+ subroutine copy3_array_data(from, to, N) bind(C)
+ import :: c_ptr
+ type(c_ptr), value :: from, to
+ integer, value :: N
+ end subroutine copy3_array_data
+ end interface
+end module offloading
+
+subroutine omp_device_ptr(AA, BBB, CC, DD, EE, FF, N)
+ use iso_c_binding
+ use offloading
+ implicit none
+
+ integer, value :: N
+ real(c_double), pointer :: AA(:), BBB(:)
+ real(c_double), allocatable, target :: CC(:), DD(:)
+ real(c_double), target :: EE(N), FF(N), dummy(1)
+
+ ! allocate(AA(N), BBB(N), CC(N), DD(N)) ! make dump more readable
+
+ ! AA = 11.0_c_double
+ ! BBB = 22.0_c_double
+ ! CC = 33.0_c_double
+ ! DD = 44.0_c_double
+ ! EE = 55.0_c_double
+ ! FF = 66.0_c_double
+
+ ! NOTE: OpenMP 5's use_device_addr is (at time of writing) not yet supported
+
+ ! pointer-type array to use_device_ptr
+ ! !$omp target data map(to:AA) map(from:BBB) use_device_ptr(AA,BBB)
+ !$omp target data map(alloc:dummy) use_device_ptr(AA,BBB)
+ call copy3_array_data(c_loc(AA), c_loc(BBB), N)
+ !$omp end target data
+
+ ! allocatable array to use_device_ptr
+ !!$omp target data map(to:CC) map(from:DD) use_device_ptr(CC,DD)
+ !$omp target data map(alloc:dummy) use_device_ptr(CC,DD)
+ call copy3_array_data(c_loc(CC), c_loc(DD), N)
+ !$omp end target data
+
+ ! fixed-size decriptorless array to use_device_ptr
+ !!$omp target data map(to:EE) map(from:FF) use_device_ptr(EE,FF)
+ !$omp target data map(alloc:dummy) use_device_ptr(EE,FF)
+ call copy3_array_data(c_loc(EE), c_loc(FF), N)
+ !$omp end target data
+
+ ! deallocate(AA, BBB) ! Free all pointers, only
+end subroutine omp_device_ptr
+
+! { dg-final { scan-tree-dump-not ".omp_data_arr.aa" "optimized" } }
+! { dg-final { scan-tree-dump-not ".omp_data_arr.\[0-9\]+.aa" "optimized" } }
+! { dg-final { scan-tree-dump-not ".omp_data_arr.bbb" "optimized" } }
+! { dg-final { scan-tree-dump-not ".omp_data_arr.\[0-9\]+.bbb" "optimized" } }
+! { dg-final { scan-tree-dump-not ".omp_data_arr.cc" "optimized" } }
+! { dg-final { scan-tree-dump-not ".omp_data_arr.\[0-9\]+.cc" "optimized" } }
+! { dg-final { scan-tree-dump-not ".omp_data_arr.dd" "optimized" } }
+! { dg-final { scan-tree-dump-not ".omp_data_arr.\[0-9\]+.dd" "optimized" } }
+
+! { dg-final { scan-tree-dump-times ".omp_data_arr.\[0-9\]+.D.\[0-9\]+ = _\[0-9\]+" 4 "optimized" } }
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = .omp_data_arr.\[0-9\]+.D.\[0-9\]+" 4 "optimized" } }
+! { dg-final { scan-tree-dump-times ".omp_data_arr.\[0-9\]+.ee = ee_\[0-9\]+.D.;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times ".omp_data_arr.\[0-9\]+.ff = ff_\[0-9\]+.D.;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = .omp_data_arr.\[0-9\]+.ee;" 1 "optimized" } }
+
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = aa_\[0-9\]+.D.->data;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "D.\[0-9\]+ = \\*aa_\[0-9\]+.D.;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "aa.\[0-9\]+ = D.\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "aa.\[0-9\]+.data = _\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "aa.\[0-9\]+_\[0-9\]+ = &aa.\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = aa.\[0-9\]+_\[0-9\]+->data;" 1 "optimized" } }
+
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = bbb_\[0-9\]+.D.->data;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "D.\[0-9\]+ = \\*bbb_\[0-9\]+.D.;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "bbb.\[0-9\]+ = D.\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "bbb.\[0-9\]+.data = _\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "bbb.\[0-9\]+_\[0-9\]+ = &bbb.\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = bbb.\[0-9\]+_\[0-9\]+->data;" 1 "optimized" } }
+
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = cc_\[0-9\]+.D.->data;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "D.\[0-9\]+ = \\*cc_\[0-9\]+.D.;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "cc.\[0-9\]+ = D.\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "cc.\[0-9\]+.data = _\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "cc.\[0-9\]+_\[0-9\]+ = &cc.\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = cc.\[0-9\]+_\[0-9\]+->data;" 1 "optimized" } }
+
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = dd_\[0-9\]+.D.->data;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "D.\[0-9\]+ = \\*dd_\[0-9\]+.D.;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "dd.\[0-9\]+ = D.\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "dd.\[0-9\]+.data = _\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "dd.\[0-9\]+_\[0-9\]+ = &dd.\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = dd.\[0-9\]+_\[0-9\]+->data;" 1 "optimized" } }
+
+! { dg-final { scan-tree-dump-times "ee.\[0-9\]+_\[0-9\]+ = _\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = ee.\[0-9\]+_\[0-9\]+" 1 "optimized" } }
+
+! { dg-final { scan-tree-dump-times "ff.\[0-9\]+_\[0-9\]+ = _\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = ff.\[0-9\]+_\[0-9\]+" 1 "optimized" } }
--- /dev/null
+! { dg-do compile }
+! { dg-options "-fopenmp -fdump-tree-optimized -O0" }
+
+! Check use_device_ptr with optional dummy arguments
+
+module offloading
+ use iso_c_binding
+ implicit none
+ interface
+ subroutine copy3_array_data(from, to, N) bind(C)
+ import :: c_ptr
+ type(c_ptr), value :: from, to
+ integer, value :: N
+ end subroutine copy3_array_data
+ end interface
+end module offloading
+
+subroutine omp_device_ptr(AA, BBB, CC, DD, EE, FF, N)
+ use iso_c_binding
+ use offloading
+ implicit none
+
+ integer, value :: N
+ real(c_double), optional, pointer :: AA(:), BBB(:)
+ real(c_double), optional, allocatable, target :: CC(:), DD(:)
+ real(c_double), optional, target :: EE(N), FF(N)
+ real(c_double) :: dummy(1)
+
+ ! allocate(AA(N), BBB(N), CC(N), DD(N)) ! make dump more readable
+
+ ! AA = 11.0_c_double
+ ! BBB = 22.0_c_double
+ ! CC = 33.0_c_double
+ ! DD = 44.0_c_double
+ ! EE = 55.0_c_double
+ ! FF = 66.0_c_double
+
+ ! NOTE: OpenMP 5's use_device_addr is (at time of writing) not yet supported
+
+ ! pointer-type array to use_device_ptr
+ ! !$omp target data map(to:AA) map(from:BBB) use_device_ptr(AA,BBB)
+ !$omp target data map(alloc:dummy) use_device_ptr(AA,BBB)
+ call copy3_array_data(c_loc(AA), c_loc(BBB), N)
+ !$omp end target data
+
+ ! allocatable array to use_device_ptr
+ !!$omp target data map(to:CC) map(from:DD) use_device_ptr(CC,DD)
+ !$omp target data map(alloc:dummy) use_device_ptr(CC,DD)
+ call copy3_array_data(c_loc(CC), c_loc(DD), N)
+ !$omp end target data
+
+ ! fixed-size decriptorless array to use_device_ptr
+ !!$omp target data map(to:EE) map(from:FF) use_device_ptr(EE,FF)
+ !$omp target data map(alloc:dummy) use_device_ptr(EE,FF)
+ call copy3_array_data(c_loc(EE), c_loc(FF), N)
+ !$omp end target data
+
+ ! deallocate(AA, BBB) ! Free all pointers, only
+end subroutine omp_device_ptr
+
+! { dg-final { scan-tree-dump-not ".omp_data_arr.aa" "optimized" } }
+! { dg-final { scan-tree-dump-not ".omp_data_arr.\[0-9\]+.aa" "optimized" } }
+! { dg-final { scan-tree-dump-not ".omp_data_arr.bbb" "optimized" } }
+! { dg-final { scan-tree-dump-not ".omp_data_arr.\[0-9\]+.bbb" "optimized" } }
+! { dg-final { scan-tree-dump-not ".omp_data_arr.cc" "optimized" } }
+! { dg-final { scan-tree-dump-not ".omp_data_arr.\[0-9\]+.cc" "optimized" } }
+! { dg-final { scan-tree-dump-not ".omp_data_arr.dd" "optimized" } }
+! { dg-final { scan-tree-dump-not ".omp_data_arr.\[0-9\]+.dd" "optimized" } }
+
+! { dg-final { scan-tree-dump-times ".omp_data_arr.\[0-9\]+.D.\[0-9\]+ = _\[0-9\]+" 4 "optimized" } }
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = .omp_data_arr.\[0-9\]+.D.\[0-9\]+" 4 "optimized" } }
+! { dg-final { scan-tree-dump-times ".omp_data_arr.\[0-9\]+.ee = ee_\[0-9\]+.D.;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times ".omp_data_arr.\[0-9\]+.ff = ff_\[0-9\]+.D.;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = .omp_data_arr.\[0-9\]+.ee;" 1 "optimized" } }
+
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = aa_\[0-9\]+.D.->data;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "D.\[0-9\]+ = \\*aa_\[0-9\]+.D.;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "aa.\[0-9\]+ = D.\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "aa.\[0-9\]+.data = _\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "aa.\[0-9\]+_\[0-9\]+ = &aa.\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = aa.\[0-9\]+_\[0-9\]+->data;" 1 "optimized" } }
+
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = bbb_\[0-9\]+.D.->data;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "D.\[0-9\]+ = \\*bbb_\[0-9\]+.D.;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "bbb.\[0-9\]+ = D.\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "bbb.\[0-9\]+.data = _\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "bbb.\[0-9\]+_\[0-9\]+ = &bbb.\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = bbb.\[0-9\]+_\[0-9\]+->data;" 1 "optimized" } }
+
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = cc_\[0-9\]+.D.->data;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "D.\[0-9\]+ = \\*cc_\[0-9\]+.D.;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "cc.\[0-9\]+ = D.\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "cc.\[0-9\]+.data = _\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "cc.\[0-9\]+_\[0-9\]+ = &cc.\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = cc.\[0-9\]+_\[0-9\]+->data;" 1 "optimized" } }
+
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = dd_\[0-9\]+.D.->data;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "D.\[0-9\]+ = \\*dd_\[0-9\]+.D.;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "dd.\[0-9\]+ = D.\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "dd.\[0-9\]+.data = _\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "dd.\[0-9\]+_\[0-9\]+ = &dd.\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = dd.\[0-9\]+_\[0-9\]+->data;" 1 "optimized" } }
+
+! { dg-final { scan-tree-dump-times "ee.\[0-9\]+_\[0-9\]+ = _\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = ee.\[0-9\]+_\[0-9\]+" 1 "optimized" } }
+
+! { dg-final { scan-tree-dump-times "ff.\[0-9\]+_\[0-9\]+ = _\[0-9\]+;" 1 "optimized" } }
+! { dg-final { scan-tree-dump-times "_\[0-9\]+ = ff.\[0-9\]+_\[0-9\]+" 1 "optimized" } }
+2019-10-09 Tobias Burnus <tobias@codesourcery.com>
+
+ * testsuite/libgomp.fortran/use_device_ptr1.f90: New.
+
2019-09-20 Julian Brown <julian@codesourcery.com>
* testsuite/libgomp.oacc-fortran/privatized-ref-1.f95: New test.
--- /dev/null
+module offloading
+ use iso_c_binding
+ implicit none
+contains
+ subroutine copy3_array_data_int(from, to, N)
+ !$omp declare target
+ type(c_ptr), value :: from, to
+ integer, value :: N
+
+ real(c_double), pointer :: from_ptr(:)
+ real(c_double), pointer :: to_ptr(:)
+ integer :: i
+
+ 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_data_int
+
+ subroutine copy3_array_data(from, to, N)
+ type(c_ptr), value :: from, to
+ integer, value :: N
+ !$omp target is_device_ptr(from, to)
+ call copy3_array_data_int(from, to, N)
+ !$omp end target
+ end subroutine copy3_array_data
+
+ subroutine copy3_array1(from, to)
+ real(c_double), target :: from(:), to(:)
+ integer :: N
+ N = size(from)
+
+ !$omp target is_device_ptr(from, to)
+ call copy3_array_data_int(c_loc(from), c_loc(to), N)
+ !$omp end target
+ end subroutine copy3_array1
+
+! ICE - the following code gives (currently) an ICE
+! It is accepted by the frontend but it is invalid
+! OpenMP 5 as only "a dummy argument that does not have the
+! ALLOCATABLE, POINTER or VALUE attribute."
+!
+! subroutine copy3_array2(from, to)
+! real(c_double), pointer :: from(:), to(:)
+! integer :: N
+! N = size(from)
+!
+! !$omp target is_device_ptr(from, to)
+! call copy3_array_data_int(c_loc(from), c_loc(to), N)
+! !$omp end target
+! end subroutine copy3_array2
+
+ subroutine copy3_array3(from, to)
+ real(c_double), optional, target :: from(:), to(:)
+ integer :: N
+ N = size(from)
+
+ !$omp target is_device_ptr(from, to)
+ call copy3_array_data_int(c_loc(from), c_loc(to), N)
+ !$omp end target
+ end subroutine copy3_array3
+
+! ICE - the following code gives (currently) an ICE
+! It is accepted by the frontend but it is invalid
+! OpenMP 5 as only "a dummy argument that does not have the
+! ALLOCATABLE, POINTER or VALUE attribute."
+!
+! subroutine copy3_array4(from, to)
+! real(c_double), optional, pointer :: from(:), to(:)
+! integer :: N
+! N = size(from)
+!
+! !$omp target is_device_ptr(from, to)
+! call copy3_array_data_int(c_loc(from), c_loc(to), N)
+! !$omp end target
+! end subroutine copy3_array4
+end module offloading
+
+
+
+module offloading2
+ use iso_c_binding
+ use offloading
+ implicit none
+contains
+ ! Same as main program but uses dummy *nonoptional* arguments
+ subroutine use_device_ptr_sub(AA, BB, CC, DD, EE, FF, AptrA, BptrB, N)
+ real(c_double), pointer :: AA(:), BB(:)
+ real(c_double), allocatable, target :: CC(:), DD(:)
+ real(c_double), target :: EE(N), FF(N), dummy(1)
+ real(c_double), pointer :: AptrA(:), BptrB(:)
+ intent(inout) :: AA, BB, CC, DD, EE, FF
+ integer, value :: N
+
+ type(c_ptr) :: tgt_aptr, tgt_bptr, tgt_cptr, tgt_dptr, tgt_eptr, tgt_fptr
+
+ 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
+
+ ! NOTE: OpenMP 5's use_device_addr is (at time of writing) not yet supported
+
+ ! pointer-type array to use_device_ptr
+ !$omp target data map(to:AA) map(from:BB)
+ !$omp target data map(alloc:dummy) use_device_ptr(AA,BB)
+ call copy3_array_data(c_loc(AA), c_loc(BB), N)
+ !$omp end target data
+ !$omp end target data
+
+ if (any(abs(AA - 11.0_c_double) > 10.0_c_double * epsilon(AA))) call abort()
+ if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) call abort()
+
+ ! allocatable array to use_device_ptr
+ !$omp target data map(to:CC) map(from:DD)
+ !$omp target data map(alloc:dummy) use_device_ptr(CC,DD)
+ call copy3_array_data(c_loc(CC), c_loc(DD), N)
+ !$omp end target data
+ !$omp end target data
+
+ if (any(abs(CC - 33.0_c_double) > 10.0_c_double * epsilon(CC))) call abort()
+ if (any(abs(3.0_c_double * CC - DD) > 10.0_c_double * epsilon(CC))) call abort()
+
+ ! fixed-size decriptorless array to use_device_ptr
+ !$omp target data map(to:EE) map(from:FF)
+ !$omp target data map(alloc:dummy) use_device_ptr(EE,FF)
+ call copy3_array_data(c_loc(EE), c_loc(FF), N)
+ !$omp end target data
+ !$omp end target data
+
+ if (any(abs(EE - 55.0_c_double) > 10.0_c_double * epsilon(EE))) call abort()
+ if (any(abs(3.0_c_double * EE - FF) > 10.0_c_double * epsilon(EE))) 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
+
+ ! pointer-type array to use_device_ptr
+ !$omp target data map(to:AA) map(from:BB)
+ !$omp target data map(alloc:dummy) use_device_ptr(AA,BB)
+ tgt_aptr = c_loc(AA)
+ tgt_bptr = c_loc(BB)
+ AptrA => AA
+ BptrB => BB
+ !$omp end target data
+
+ call copy3_array_data(tgt_aptr, tgt_bptr, N)
+ !$omp target update from(BB)
+ if (any(abs(AA - 111.0_c_double) > 10.0_c_double * epsilon(AA))) call abort()
+ if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) call abort()
+
+ AA = 1111.0_c_double
+ !$omp target update to(AA)
+ call copy3_array_data(tgt_aptr, tgt_bptr, N)
+ !$omp target update from(BB)
+ if (any(abs(AA - 1111.0_c_double) > 10.0_c_double * epsilon(AA))) call abort()
+ if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) call abort()
+
+ ! AprtA tests
+ AA = 7.0_c_double
+ !$omp target update to(AA)
+ call copy3_array_data(c_loc(AptrA), c_loc(BptrB), N)
+ !$omp target update from(BB)
+ if (any(abs(AA - 7.0_c_double) > 10.0_c_double * epsilon(AA))) call abort()
+ if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) call abort()
+
+ AA = 77.0_c_double
+ !$omp target update to(AA)
+ call copy3_array1(AptrA, BptrB)
+ !$omp target update from(BB)
+ if (any(abs(AA - 77.0_c_double) > 10.0_c_double * epsilon(AA))) call abort()
+ if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) call abort()
+
+! AA = 777.0_c_double
+! !$omp target update to(AA)
+! call copy3_array2(AptrA, BptrB)
+! !$omp target update from(BB)
+! if (any(abs(AA - 777.0_c_double) > 10.0_c_double * epsilon(AA))) call abort()
+! if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) call abort()
+
+ AA = 7777.0_c_double
+ !$omp target update to(AA)
+ call copy3_array3(AptrA, BptrB)
+ !$omp target update from(BB)
+ if (any(abs(AA - 7777.0_c_double) > 10.0_c_double * epsilon(AA))) call abort()
+ if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) call abort()
+
+! AA = 77777.0_c_double
+! !$omp target update to(AA)
+! call copy3_array4(AptrA, BptrB)
+! !$omp target update from(BB)
+ !$omp end target data
+!
+! if (any(abs(AA - 77777.0_c_double) > 10.0_c_double * epsilon(AA))) call abort()
+! if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) call abort()
+
+
+
+ ! allocatable array to use_device_ptr
+ !$omp target data map(to:CC) map(from:DD)
+ !$omp target data map(alloc:dummy) use_device_ptr(CC,DD)
+ tgt_cptr = c_loc(CC)
+ tgt_dptr = c_loc(DD)
+ !$omp end target data
+
+ call copy3_array_data(tgt_cptr, tgt_dptr, N)
+ !$omp target update from(DD)
+ if (any(abs(CC - 333.0_c_double) > 10.0_c_double * epsilon(CC))) call abort()
+ if (any(abs(3.0_c_double * CC - DD) > 10.0_c_double * epsilon(CC))) call abort()
+
+ CC = 3333.0_c_double
+ !$omp target update to(CC)
+ call copy3_array_data(tgt_cptr, tgt_dptr, N)
+ !$omp target update from(DD)
+ !$omp end target data
+
+ if (any(abs(CC - 3333.0_c_double) > 10.0_c_double * epsilon(CC))) call abort()
+ if (any(abs(3.0_c_double * CC - DD) > 10.0_c_double * epsilon(CC))) call abort()
+
+
+
+ ! fixed-size decriptorless array to use_device_ptr
+ !$omp target data map(to:EE) map(from:FF)
+ !$omp target data map(alloc:dummy) use_device_ptr(EE,FF)
+ tgt_eptr = c_loc(EE)
+ tgt_fptr = c_loc(FF)
+ !$omp end target data
+
+ call copy3_array_data(tgt_eptr, tgt_fptr, N)
+ !$omp target update from(FF)
+ if (any(abs(EE - 555.0_c_double) > 10.0_c_double * epsilon(EE))) call abort()
+ if (any(abs(3.0_c_double * EE - FF) > 10.0_c_double * epsilon(EE))) call abort()
+
+ EE = 5555.0_c_double
+ !$omp target update to(EE)
+ call copy3_array_data(tgt_eptr, tgt_fptr, N)
+ !$omp target update from(FF)
+ !$omp end target data
+
+ if (any(abs(EE - 5555.0_c_double) > 10.0_c_double * epsilon(EE))) call abort()
+ if (any(abs(3.0_c_double * EE - FF) > 10.0_c_double * epsilon(EE))) call abort()
+ end subroutine use_device_ptr_sub
+
+
+
+ ! Same as main program but uses dummy *optional* arguments
+ subroutine use_device_ptr_sub2(AA, BB, CC, DD, EE, FF, AptrA, BptrB, N)
+ real(c_double), optional, pointer :: AA(:), BB(:)
+ real(c_double), optional, allocatable, target :: CC(:), DD(:)
+ real(c_double), optional, target :: EE(N), FF(N)
+ real(c_double), pointer :: AptrA(:), BptrB(:)
+ intent(inout) :: AA, BB, CC, DD, EE, FF
+ real(c_double), target :: dummy(1)
+ integer, value :: N
+
+ type(c_ptr) :: tgt_aptr, tgt_bptr, tgt_cptr, tgt_dptr, tgt_eptr, tgt_fptr
+
+ 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
+
+ ! NOTE: OpenMP 5's use_device_addr is (at time of writing) not yet supported
+
+ ! pointer-type array to use_device_ptr
+ !$omp target data map(to:AA) map(from:BB)
+ !$omp target data map(alloc:dummy) use_device_ptr(AA,BB)
+ call copy3_array_data(c_loc(AA), c_loc(BB), N)
+ !$omp end target data
+ !$omp end target data
+
+ if (any(abs(AA - 11.0_c_double) > 10.0_c_double * epsilon(AA))) call abort()
+ if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) call abort()
+
+ ! allocatable array to use_device_ptr
+ !$omp target data map(to:CC) map(from:DD)
+ !$omp target data map(alloc:dummy) use_device_ptr(CC,DD)
+ call copy3_array_data(c_loc(CC), c_loc(DD), N)
+ !$omp end target data
+ !$omp end target data
+
+ if (any(abs(CC - 33.0_c_double) > 10.0_c_double * epsilon(CC))) call abort()
+ if (any(abs(3.0_c_double * CC - DD) > 10.0_c_double * epsilon(CC))) call abort()
+
+ ! fixed-size decriptorless array to use_device_ptr
+ !$omp target data map(to:EE) map(from:FF)
+ !$omp target data map(alloc:dummy) use_device_ptr(EE,FF)
+ call copy3_array_data(c_loc(EE), c_loc(FF), N)
+ !$omp end target data
+ !$omp end target data
+
+ if (any(abs(EE - 55.0_c_double) > 10.0_c_double * epsilon(EE))) call abort()
+ if (any(abs(3.0_c_double * EE - FF) > 10.0_c_double * epsilon(EE))) 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
+
+ ! pointer-type array to use_device_ptr
+ !$omp target data map(to:AA) map(from:BB)
+ !$omp target data map(alloc:dummy) use_device_ptr(AA,BB)
+ tgt_aptr = c_loc(AA)
+ tgt_bptr = c_loc(BB)
+ AptrA => AA
+ BptrB => BB
+ !$omp end target data
+
+ call copy3_array_data(tgt_aptr, tgt_bptr, N)
+ !$omp target update from(BB)
+ if (any(abs(AA - 111.0_c_double) > 10.0_c_double * epsilon(AA))) call abort()
+ if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) call abort()
+
+ AA = 1111.0_c_double
+ !$omp target update to(AA)
+ call copy3_array_data(tgt_aptr, tgt_bptr, N)
+ !$omp target update from(BB)
+ if (any(abs(AA - 1111.0_c_double) > 10.0_c_double * epsilon(AA))) call abort()
+ if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) call abort()
+
+ ! AprtA tests
+ AA = 7.0_c_double
+ !$omp target update to(AA)
+ call copy3_array_data(c_loc(AptrA), c_loc(BptrB), N)
+ !$omp target update from(BB)
+ if (any(abs(AA - 7.0_c_double) > 10.0_c_double * epsilon(AA))) call abort()
+ if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) call abort()
+
+ AA = 77.0_c_double
+ !$omp target update to(AA)
+ call copy3_array1(AptrA, BptrB)
+ !$omp target update from(BB)
+ if (any(abs(AA - 77.0_c_double) > 10.0_c_double * epsilon(AA))) call abort()
+ if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) call abort()
+
+! AA = 777.0_c_double
+! !$omp target update to(AA)
+! call copy3_array2(AptrA, BptrB)
+! !$omp target update from(BB)
+! if (any(abs(AA - 777.0_c_double) > 10.0_c_double * epsilon(AA))) call abort()
+! if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) call abort()
+
+ AA = 7777.0_c_double
+ !$omp target update to(AA)
+ call copy3_array3(AptrA, BptrB)
+ !$omp target update from(BB)
+ if (any(abs(AA - 7777.0_c_double) > 10.0_c_double * epsilon(AA))) call abort()
+ if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) call abort()
+
+! AA = 77777.0_c_double
+! !$omp target update to(AA)
+! call copy3_array4(AptrA, BptrB)
+! !$omp target update from(BB)
+ !$omp end target data
+!
+! if (any(abs(AA - 77777.0_c_double) > 10.0_c_double * epsilon(AA))) call abort()
+! if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) call abort()
+
+
+
+ ! allocatable array to use_device_ptr
+ !$omp target data map(to:CC) map(from:DD)
+ !$omp target data map(alloc:dummy) use_device_ptr(CC,DD)
+ tgt_cptr = c_loc(CC)
+ tgt_dptr = c_loc(DD)
+ !$omp end target data
+
+ call copy3_array_data(tgt_cptr, tgt_dptr, N)
+ !$omp target update from(DD)
+ if (any(abs(CC - 333.0_c_double) > 10.0_c_double * epsilon(CC))) call abort()
+ if (any(abs(3.0_c_double * CC - DD) > 10.0_c_double * epsilon(CC))) call abort()
+
+ CC = 3333.0_c_double
+ !$omp target update to(CC)
+ call copy3_array_data(tgt_cptr, tgt_dptr, N)
+ !$omp target update from(DD)
+ !$omp end target data
+
+ if (any(abs(CC - 3333.0_c_double) > 10.0_c_double * epsilon(CC))) call abort()
+ if (any(abs(3.0_c_double * CC - DD) > 10.0_c_double * epsilon(CC))) call abort()
+
+
+
+ ! fixed-size decriptorless array to use_device_ptr
+ !$omp target data map(to:EE) map(from:FF)
+ !$omp target data map(alloc:dummy) use_device_ptr(EE,FF)
+ tgt_eptr = c_loc(EE)
+ tgt_fptr = c_loc(FF)
+ !$omp end target data
+
+ call copy3_array_data(tgt_eptr, tgt_fptr, N)
+ !$omp target update from(FF)
+ if (any(abs(EE - 555.0_c_double) > 10.0_c_double * epsilon(EE))) call abort()
+ if (any(abs(3.0_c_double * EE - FF) > 10.0_c_double * epsilon(EE))) call abort()
+
+ EE = 5555.0_c_double
+ !$omp target update to(EE)
+ call copy3_array_data(tgt_eptr, tgt_fptr, N)
+ !$omp end target data
+
+ if (any(abs(EE - 5555.0_c_double) > 10.0_c_double * epsilon(EE))) call abort()
+ if (any(abs(3.0_c_double * EE - FF) > 10.0_c_double * epsilon(EE))) call abort()
+ end subroutine use_device_ptr_sub2
+end module offloading2
+
+
+
+program omp_device_ptr
+ use iso_c_binding
+ use offloading
+ use offloading2
+ implicit none
+
+ integer, parameter :: N = 1000
+ real(c_double), pointer :: AA(:), BB(:), arg_AA(:), arg_BB(:), arg2_AA(:), arg2_BB(:)
+ real(c_double), allocatable, target :: CC(:), DD(:), arg_CC(:), arg_DD(:), arg2_CC(:), arg2_DD(:)
+ real(c_double), target :: EE(N), FF(N), dummy(1), arg_EE(N), arg_FF(N), arg2_EE(N), arg2_FF(N)
+
+ real(c_double), pointer :: AptrA(:), BptrB(:)
+ type(c_ptr) :: tgt_aptr, tgt_bptr, tgt_cptr, tgt_dptr, tgt_eptr, tgt_fptr
+
+ allocate(AA(N), BB(N), CC(N), DD(N))
+
+ AA = 11.0_c_double
+ BB = 22.0_c_double
+ CC = 33.0_c_double
+ DD = 44.0_c_double
+ EE = 55.0_c_double
+ FF = 66.0_c_double
+
+ ! NOTE: OpenMP 5's use_device_addr is (at time of writing) not yet supported
+
+ ! pointer-type array to use_device_ptr
+ !$omp target data map(to:AA) map(from:BB)
+ !$omp target data map(alloc:dummy) use_device_ptr(AA,BB)
+ call copy3_array_data(c_loc(AA), c_loc(BB), N)
+ !$omp end target data
+ !$omp end target data
+
+ if (any(abs(AA - 11.0_c_double) > 10.0_c_double * epsilon(AA))) call abort()
+ if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) call abort()
+
+ ! allocatable array to use_device_ptr
+ !$omp target data map(to:CC) map(from:DD)
+ !$omp target data map(alloc:dummy) use_device_ptr(CC,DD)
+ call copy3_array_data(c_loc(CC), c_loc(DD), N)
+ !$omp end target data
+ !$omp end target data
+
+ if (any(abs(CC - 33.0_c_double) > 10.0_c_double * epsilon(CC))) call abort()
+ if (any(abs(3.0_c_double * CC - DD) > 10.0_c_double * epsilon(CC))) call abort()
+
+ ! fixed-size decriptorless array to use_device_ptr
+ !$omp target data map(to:EE) map(from:FF)
+ !$omp target data map(alloc:dummy) use_device_ptr(EE,FF)
+ call copy3_array_data(c_loc(EE), c_loc(FF), N)
+ !$omp end target data
+ !$omp end target data
+
+ if (any(abs(EE - 55.0_c_double) > 10.0_c_double * epsilon(EE))) call abort()
+ if (any(abs(3.0_c_double * EE - FF) > 10.0_c_double * epsilon(EE))) 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
+
+ ! pointer-type array to use_device_ptr
+ !$omp target data map(to:AA) map(from:BB)
+ !$omp target data map(alloc:dummy) use_device_ptr(AA,BB)
+ tgt_aptr = c_loc(AA)
+ tgt_bptr = c_loc(BB)
+ AptrA => AA
+ BptrB => BB
+ !$omp end target data
+
+ call copy3_array_data(tgt_aptr, tgt_bptr, N)
+ !$omp target update from(BB)
+ if (any(abs(AA - 111.0_c_double) > 10.0_c_double * epsilon(AA))) call abort()
+ if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) call abort()
+
+ AA = 1111.0_c_double
+ !$omp target update to(AA)
+ call copy3_array_data(tgt_aptr, tgt_bptr, N)
+ !$omp target update from(BB)
+ if (any(abs(AA - 1111.0_c_double) > 10.0_c_double * epsilon(AA))) call abort()
+ if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) call abort()
+
+ ! AprtA tests
+ AA = 7.0_c_double
+ !$omp target update to(AA)
+ call copy3_array_data(c_loc(AptrA), c_loc(BptrB), N)
+ !$omp target update from(BB)
+ if (any(abs(AA - 7.0_c_double) > 10.0_c_double * epsilon(AA))) call abort()
+ if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) call abort()
+
+ AA = 77.0_c_double
+ !$omp target update to(AA)
+ call copy3_array1(AptrA, BptrB)
+ !$omp target update from(BB)
+ if (any(abs(AA - 77.0_c_double) > 10.0_c_double * epsilon(AA))) call abort()
+ if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) call abort()
+
+! AA = 777.0_c_double
+! !$omp target update to(AA)
+! call copy3_array2(AptrA, BptrB)
+! !$omp target update from(BB)
+! if (any(abs(AA - 777.0_c_double) > 10.0_c_double * epsilon(AA))) call abort()
+! if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) call abort()
+
+ AA = 7777.0_c_double
+ !$omp target update to(AA)
+ call copy3_array3(AptrA, BptrB)
+ !$omp target update from(BB)
+ if (any(abs(AA - 7777.0_c_double) > 10.0_c_double * epsilon(AA))) call abort()
+ if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) call abort()
+
+! AA = 77777.0_c_double
+! !$omp target update to(AA)
+! call copy3_array4(AptrA, BptrB)
+! !$omp target update from(BB)
+ !$omp end target data
+!
+! if (any(abs(AA - 77777.0_c_double) > 10.0_c_double * epsilon(AA))) call abort()
+! if (any(abs(3.0_c_double * AA - BB) > 10.0_c_double * epsilon(AA))) call abort()
+
+
+
+ ! allocatable array to use_device_ptr
+ !$omp target data map(to:CC) map(from:DD)
+ !$omp target data map(alloc:dummy) use_device_ptr(CC,DD)
+ tgt_cptr = c_loc(CC)
+ tgt_dptr = c_loc(DD)
+ !$omp end target data
+
+ call copy3_array_data(tgt_cptr, tgt_dptr, N)
+ !$omp target update from(DD)
+ if (any(abs(CC - 333.0_c_double) > 10.0_c_double * epsilon(CC))) call abort()
+ if (any(abs(3.0_c_double * CC - DD) > 10.0_c_double * epsilon(CC))) call abort()
+
+ CC = 3333.0_c_double
+ !$omp target update to(CC)
+ call copy3_array_data(tgt_cptr, tgt_dptr, N)
+ !$omp target update from(DD)
+ !$omp end target data
+
+ if (any(abs(CC - 3333.0_c_double) > 10.0_c_double * epsilon(CC))) call abort()
+ if (any(abs(3.0_c_double * CC - DD) > 10.0_c_double * epsilon(CC))) call abort()
+
+
+
+ ! fixed-size decriptorless array to use_device_ptr
+ !$omp target data map(to:EE) map(from:FF)
+ !$omp target data map(alloc:dummy) use_device_ptr(EE,FF)
+ tgt_eptr = c_loc(EE)
+ tgt_fptr = c_loc(FF)
+ !$omp end target data
+
+ call copy3_array_data(tgt_eptr, tgt_fptr, N)
+ !$omp target update from(FF)
+ if (any(abs(EE - 555.0_c_double) > 10.0_c_double * epsilon(EE))) call abort()
+ if (any(abs(3.0_c_double * EE - FF) > 10.0_c_double * epsilon(EE))) call abort()
+
+ EE = 5555.0_c_double
+ !$omp target update to(EE)
+ call copy3_array_data(tgt_eptr, tgt_fptr, N)
+ !$omp target update from(FF)
+ !$omp end target data
+
+ if (any(abs(EE - 5555.0_c_double) > 10.0_c_double * epsilon(EE))) call abort()
+ if (any(abs(3.0_c_double * EE - FF) > 10.0_c_double * epsilon(EE))) call abort()
+
+
+
+ deallocate(AA, BB) ! Free pointers only
+
+ AptrA => null()
+ BptrB => null()
+ allocate(arg_AA(N), arg_BB(N), arg_CC(N), arg_DD(N))
+ call use_device_ptr_sub(arg_AA, arg_BB, arg_CC, arg_DD, arg_EE, arg_FF, AptrA, BptrB, N)
+ deallocate(arg_AA, arg_BB)
+
+ AptrA => null()
+ BptrB => null()
+ allocate(arg2_AA(N), arg2_BB(N), arg2_CC(N), arg2_DD(N))
+ call use_device_ptr_sub2(arg2_AA, arg2_BB, arg2_CC, arg2_DD, arg2_EE, arg2_FF, AptrA, BptrB, N)
+ deallocate(arg2_AA, arg2_BB)
+end program omp_device_ptr
projects / thirdparty / gcc.git / commitdiff
