Commit 92e63bd2 by Tobias Burnus Committed by Tobias Burnus

OpenMP] use_device_addr/use_device_ptr with Fortran allocatable/pointer arrays

        gcc/fortran/
        * f95-lang.c (LANG_HOOKS_OMP_ARRAY_DATA): Set to gfc_omp_array_data.
        * trans-array.c (gfc_conv_descriptor_data_get): Handle also
        REFERENCE_TYPE.
        * trans-openmp.c (gfc_omp_array_data): New.
        * trans.h (gfc_omp_array_data): New prototype.

        gcc/
        * hooks.c (hook_tree_tree_bool_null): New.
        * hooks.h (hook_tree_tree_bool_null): Declare.
        * langhooks-def.h (LANG_HOOKS_OMP_ARRAY_DATA): Define.
        (LANG_HOOKS_DECLS): Add it.
        * langhooks.h (lang_hooks_for_decls): Add omp_array_data.
        * omp-low.c (install_var_field): New mode for Fortran descriptor arrays.
        (lower_omp_target): Handle Fortran array with descriptor in
        OMP_CLAUSE_USE_DEVICE_ADDR/OMP_CLAUSE_USE_DEVICE_PTR.

        libgomp/
        * testsuite/libgomp.fortran/use_device_addr-1.f90 (test_nullptr_1,
        test_dummy_opt_nullptr_callee_1): Add present but unallocated test.
        * testsuite/libgomp.fortran/use_device_addr-2.f90: Likewise.
        * testsuite/libgomp.fortran/use_device_addr-3.f90: New.
        * testsuite/libgomp.fortran/use_device_addr-4.f90: New.
        * testsuite/testsuite/libgomp.fortran/use_device_ptr-1.f90: New.

From-SVN: r277705
parent 271da732
2019-11-01 Tobias Burnus <tobias@codesourcery.com>
* hooks.c (hook_tree_tree_bool_null): New.
* hooks.h (hook_tree_tree_bool_null): Declare.
* langhooks-def.h (LANG_HOOKS_OMP_ARRAY_DATA): Define.
(LANG_HOOKS_DECLS): Add it.
* langhooks.h (lang_hooks_for_decls): Add omp_array_data.
* omp-low.c (install_var_field): New mode for Fortran descriptor arrays.
(lower_omp_target): Handle Fortran array with descriptor in
OMP_CLAUSE_USE_DEVICE_ADDR/OMP_CLAUSE_USE_DEVICE_PTR.
2019-10-31 Richard Sandiford <richard.sandiford@arm.com> 2019-10-31 Richard Sandiford <richard.sandiford@arm.com>
* config/aarch64/aarch64-sve-builtins.cc (register_builtin_types): * config/aarch64/aarch64-sve-builtins.cc (register_builtin_types):
2019-11-01 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 also
REFERENCE_TYPE.
* trans-openmp.c (gfc_omp_array_data): New.
* trans.h (gfc_omp_array_data): New prototype.
2019-10-31 Tobias Burnus <tobias@codesourcery.com> 2019-10-31 Tobias Burnus <tobias@codesourcery.com>
PR fortran/92284. PR fortran/92284.
......
...@@ -113,6 +113,7 @@ static const struct attribute_spec gfc_attribute_table[] = ...@@ -113,6 +113,7 @@ static const struct attribute_spec gfc_attribute_table[] =
#undef LANG_HOOKS_TYPE_FOR_MODE #undef LANG_HOOKS_TYPE_FOR_MODE
#undef LANG_HOOKS_TYPE_FOR_SIZE #undef LANG_HOOKS_TYPE_FOR_SIZE
#undef LANG_HOOKS_INIT_TS #undef LANG_HOOKS_INIT_TS
#undef LANG_HOOKS_OMP_ARRAY_DATA
#undef LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR #undef LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR
#undef LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT #undef LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT
#undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE #undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE
...@@ -147,6 +148,7 @@ static const struct attribute_spec gfc_attribute_table[] = ...@@ -147,6 +148,7 @@ static const struct attribute_spec gfc_attribute_table[] =
#define LANG_HOOKS_TYPE_FOR_MODE gfc_type_for_mode #define LANG_HOOKS_TYPE_FOR_MODE gfc_type_for_mode
#define LANG_HOOKS_TYPE_FOR_SIZE gfc_type_for_size #define LANG_HOOKS_TYPE_FOR_SIZE gfc_type_for_size
#define LANG_HOOKS_INIT_TS gfc_init_ts #define LANG_HOOKS_INIT_TS gfc_init_ts
#define LANG_HOOKS_OMP_ARRAY_DATA gfc_omp_array_data
#define LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR gfc_omp_is_allocatable_or_ptr #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_IS_OPTIONAL_ARGUMENT gfc_omp_is_optional_argument
#define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE gfc_omp_privatize_by_reference #define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE gfc_omp_privatize_by_reference
......
...@@ -142,6 +142,9 @@ gfc_conv_descriptor_data_get (tree desc) ...@@ -142,6 +142,9 @@ gfc_conv_descriptor_data_get (tree desc)
tree field, type, t; tree field, type, t;
type = TREE_TYPE (desc); type = TREE_TYPE (desc);
if (TREE_CODE (type) == REFERENCE_TYPE)
type = TREE_TYPE (type);
gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
field = TYPE_FIELDS (type); field = TYPE_FIELDS (type);
......
...@@ -71,6 +71,33 @@ gfc_omp_is_optional_argument (const_tree decl) ...@@ -71,6 +71,33 @@ gfc_omp_is_optional_argument (const_tree decl)
&& GFC_DECL_OPTIONAL_ARGUMENT (decl)); && GFC_DECL_OPTIONAL_ARGUMENT (decl));
} }
/* Returns tree with NULL if it is not an array descriptor and with the tree to
access the 'data' component otherwise. With type_only = true, it returns the
TREE_TYPE without creating a new tree. */
tree
gfc_omp_array_data (tree decl, bool type_only)
{
tree type = TREE_TYPE (decl);
if (POINTER_TYPE_P (type))
type = TREE_TYPE (type);
if (!GFC_DESCRIPTOR_TYPE_P (type))
return NULL_TREE;
if (type_only)
return GFC_TYPE_ARRAY_DATAPTR_TYPE (type);
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 /* True if OpenMP should privatize what this DECL points to rather
than the DECL itself. */ than the DECL itself. */
......
...@@ -788,6 +788,7 @@ bool gfc_get_array_descr_info (const_tree, struct array_descr_info *); ...@@ -788,6 +788,7 @@ bool gfc_get_array_descr_info (const_tree, struct array_descr_info *);
/* In trans-openmp.c */ /* In trans-openmp.c */
bool gfc_omp_is_allocatable_or_ptr (const_tree); bool gfc_omp_is_allocatable_or_ptr (const_tree);
bool gfc_omp_is_optional_argument (const_tree); bool gfc_omp_is_optional_argument (const_tree);
tree gfc_omp_array_data (tree, bool);
bool gfc_omp_privatize_by_reference (const_tree); bool gfc_omp_privatize_by_reference (const_tree);
enum omp_clause_default_kind gfc_omp_predetermined_sharing (tree); enum omp_clause_default_kind gfc_omp_predetermined_sharing (tree);
tree gfc_omp_report_decl (tree); tree gfc_omp_report_decl (tree);
......
...@@ -430,6 +430,12 @@ hook_tree_tree_int_treep_bool_null (tree, int, tree *, bool) ...@@ -430,6 +430,12 @@ hook_tree_tree_int_treep_bool_null (tree, int, tree *, bool)
} }
tree tree
hook_tree_tree_bool_null (tree, bool)
{
return NULL;
}
tree
hook_tree_tree_tree_null (tree, tree) hook_tree_tree_tree_null (tree, tree)
{ {
return NULL; return NULL;
......
...@@ -106,6 +106,7 @@ extern HOST_WIDE_INT hook_hwi_void_0 (void); ...@@ -106,6 +106,7 @@ extern HOST_WIDE_INT hook_hwi_void_0 (void);
extern tree hook_tree_const_tree_null (const_tree); extern tree hook_tree_const_tree_null (const_tree);
extern tree hook_tree_void_null (void); extern tree hook_tree_void_null (void);
extern tree hook_tree_tree_bool_null (tree, bool);
extern tree hook_tree_tree_tree_null (tree, 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_tree_tree_null (tree, tree, tree);
extern tree hook_tree_tree_int_treep_bool_null (tree, int, tree *, bool); extern tree hook_tree_tree_int_treep_bool_null (tree, int, tree *, bool);
......
...@@ -239,6 +239,7 @@ extern tree lhd_unit_size_without_reusable_padding (tree); ...@@ -239,6 +239,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_WARN_UNUSED_GLOBAL_DECL lhd_warn_unused_global_decl
#define LANG_HOOKS_POST_COMPILATION_PARSING_CLEANUPS NULL #define LANG_HOOKS_POST_COMPILATION_PARSING_CLEANUPS NULL
#define LANG_HOOKS_DECL_OK_FOR_SIBCALL lhd_decl_ok_for_sibcall #define LANG_HOOKS_DECL_OK_FOR_SIBCALL lhd_decl_ok_for_sibcall
#define LANG_HOOKS_OMP_ARRAY_DATA hook_tree_tree_bool_null
#define LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR hook_bool_const_tree_false #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_IS_OPTIONAL_ARGUMENT hook_bool_const_tree_false
#define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE hook_bool_const_tree_false #define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE hook_bool_const_tree_false
...@@ -266,6 +267,7 @@ extern tree lhd_unit_size_without_reusable_padding (tree); ...@@ -266,6 +267,7 @@ extern tree lhd_unit_size_without_reusable_padding (tree);
LANG_HOOKS_WARN_UNUSED_GLOBAL_DECL, \ LANG_HOOKS_WARN_UNUSED_GLOBAL_DECL, \
LANG_HOOKS_POST_COMPILATION_PARSING_CLEANUPS, \ LANG_HOOKS_POST_COMPILATION_PARSING_CLEANUPS, \
LANG_HOOKS_DECL_OK_FOR_SIBCALL, \ LANG_HOOKS_DECL_OK_FOR_SIBCALL, \
LANG_HOOKS_OMP_ARRAY_DATA, \
LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR, \ LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR, \
LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT, \ LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT, \
LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE, \ LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE, \
......
...@@ -226,6 +226,11 @@ struct lang_hooks_for_decls ...@@ -226,6 +226,11 @@ struct lang_hooks_for_decls
/* True if this decl may be called via a sibcall. */ /* True if this decl may be called via a sibcall. */
bool (*ok_for_sibcall) (const_tree); bool (*ok_for_sibcall) (const_tree);
/* Return a tree for the actual data of an array descriptor - or NULL_TREE
if original tree is not an array descriptor. If the the second argument
is true, only the TREE_TYPE is returned without generating a new tree. */
tree (*omp_array_data) (tree, bool);
/* True if OpenMP should regard this DECL as being a scalar which has Fortran's /* True if OpenMP should regard this DECL as being a scalar which has Fortran's
allocatable or pointer attribute. */ allocatable or pointer attribute. */
bool (*omp_is_allocatable_or_ptr) (const_tree); bool (*omp_is_allocatable_or_ptr) (const_tree);
......
...@@ -715,6 +715,11 @@ install_var_field (tree var, bool by_ref, int mask, omp_context *ctx) ...@@ -715,6 +715,11 @@ install_var_field (tree var, bool by_ref, int mask, omp_context *ctx)
tree field, type, sfield = NULL_TREE; tree field, type, sfield = NULL_TREE;
splay_tree_key key = (splay_tree_key) var; splay_tree_key key = (splay_tree_key) var;
if ((mask & 16) != 0)
{
key = (splay_tree_key) &DECL_NAME (var);
gcc_checking_assert (key != (splay_tree_key) var);
}
if ((mask & 8) != 0) if ((mask & 8) != 0)
{ {
key = (splay_tree_key) &DECL_UID (var); key = (splay_tree_key) &DECL_UID (var);
...@@ -728,6 +733,9 @@ install_var_field (tree var, bool by_ref, int mask, omp_context *ctx) ...@@ -728,6 +733,9 @@ install_var_field (tree var, bool by_ref, int mask, omp_context *ctx)
|| !is_gimple_omp_oacc (ctx->stmt)); || !is_gimple_omp_oacc (ctx->stmt));
type = TREE_TYPE (var); type = TREE_TYPE (var);
if ((mask & 16) != 0)
type = lang_hooks.decls.omp_array_data (var, true);
/* Prevent redeclaring the var in the split-off function with a restrict /* Prevent redeclaring the var in the split-off function with a restrict
pointer type. Note that we only clear type itself, restrict qualifiers in pointer type. Note that we only clear type itself, restrict qualifiers in
the pointed-to type will be ignored by points-to analysis. */ the pointed-to type will be ignored by points-to analysis. */
...@@ -752,7 +760,7 @@ install_var_field (tree var, bool by_ref, int mask, omp_context *ctx) ...@@ -752,7 +760,7 @@ install_var_field (tree var, bool by_ref, int mask, omp_context *ctx)
side effect of making dwarf2out ignore this member, so for helpful side effect of making dwarf2out ignore this member, so for helpful
debugging we clear it later in delete_omp_context. */ debugging we clear it later in delete_omp_context. */
DECL_ABSTRACT_ORIGIN (field) = var; 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)); SET_DECL_ALIGN (field, DECL_ALIGN (var));
DECL_USER_ALIGN (field) = DECL_USER_ALIGN (var); DECL_USER_ALIGN (field) = DECL_USER_ALIGN (var);
...@@ -1240,10 +1248,14 @@ scan_sharing_clauses (tree clauses, omp_context *ctx) ...@@ -1240,10 +1248,14 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE_USE_DEVICE_PTR: case OMP_CLAUSE_USE_DEVICE_PTR:
case OMP_CLAUSE_USE_DEVICE_ADDR: case OMP_CLAUSE_USE_DEVICE_ADDR:
decl = OMP_CLAUSE_DECL (c); decl = OMP_CLAUSE_DECL (c);
if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR
&& !omp_is_reference (decl) /* Fortran array descriptors. */
&& !omp_is_allocatable_or_ptr (decl)) if (lang_hooks.decls.omp_array_data (decl, true))
|| TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE) install_var_field (decl, false, 19, ctx);
else if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR
&& !omp_is_reference (decl)
&& !omp_is_allocatable_or_ptr (decl))
|| TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE)
install_var_field (decl, true, 11, ctx); install_var_field (decl, true, 11, ctx);
else else
install_var_field (decl, false, 11, ctx); install_var_field (decl, false, 11, ctx);
...@@ -11485,7 +11497,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) ...@@ -11485,7 +11497,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
} }
else if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR 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)) && !omp_is_allocatable_or_ptr (var)
&& !lang_hooks.decls.omp_array_data (var, true))
|| TREE_CODE (TREE_TYPE (var)) == ARRAY_TYPE) || TREE_CODE (TREE_TYPE (var)) == ARRAY_TYPE)
{ {
tree new_var = lookup_decl (var, ctx); tree new_var = lookup_decl (var, ctx);
...@@ -11866,7 +11879,14 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) ...@@ -11866,7 +11879,14 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
case OMP_CLAUSE_IS_DEVICE_PTR: case OMP_CLAUSE_IS_DEVICE_PTR:
ovar = OMP_CLAUSE_DECL (c); ovar = OMP_CLAUSE_DECL (c);
var = lookup_decl_in_outer_ctx (ovar, ctx); var = lookup_decl_in_outer_ctx (ovar, ctx);
if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_IS_DEVICE_PTR)
if (lang_hooks.decls.omp_array_data (ovar, true))
{
tkind = (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_IS_DEVICE_PTR
? GOMP_MAP_USE_DEVICE_PTR : GOMP_MAP_FIRSTPRIVATE_INT);
x = build_sender_ref ((splay_tree_key) &DECL_NAME (ovar), ctx);
}
else if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_IS_DEVICE_PTR)
{ {
tkind = GOMP_MAP_USE_DEVICE_PTR; tkind = GOMP_MAP_USE_DEVICE_PTR;
x = build_sender_ref ((splay_tree_key) &DECL_UID (ovar), ctx); x = build_sender_ref ((splay_tree_key) &DECL_UID (ovar), ctx);
...@@ -11877,10 +11897,12 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) ...@@ -11877,10 +11897,12 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
x = build_sender_ref (ovar, ctx); x = build_sender_ref (ovar, ctx);
} }
type = TREE_TYPE (ovar); type = TREE_TYPE (ovar);
if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR if (lang_hooks.decls.omp_array_data (ovar, true))
&& !omp_is_reference (ovar) var = lang_hooks.decls.omp_array_data (ovar, false);
&& !omp_is_allocatable_or_ptr (ovar)) else if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR
|| TREE_CODE (type) == ARRAY_TYPE) && !omp_is_reference (ovar)
&& !omp_is_allocatable_or_ptr (ovar))
|| TREE_CODE (type) == ARRAY_TYPE)
var = build_fold_addr_expr (var); var = build_fold_addr_expr (var);
else else
{ {
...@@ -12048,11 +12070,50 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) ...@@ -12048,11 +12070,50 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
case OMP_CLAUSE_USE_DEVICE_ADDR: case OMP_CLAUSE_USE_DEVICE_ADDR:
case OMP_CLAUSE_IS_DEVICE_PTR: case OMP_CLAUSE_IS_DEVICE_PTR:
var = OMP_CLAUSE_DECL (c); var = OMP_CLAUSE_DECL (c);
bool is_array_data;
is_array_data = lang_hooks.decls.omp_array_data (var, true) != NULL;
if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_IS_DEVICE_PTR) if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_IS_DEVICE_PTR)
x = build_sender_ref ((splay_tree_key) &DECL_UID (var), ctx); x = build_sender_ref (is_array_data
? (splay_tree_key) &DECL_NAME (var)
: (splay_tree_key) &DECL_UID (var), ctx);
else else
x = build_receiver_ref (var, false, ctx); x = build_receiver_ref (var, false, ctx);
if (is_variable_sized (var))
if (is_array_data)
{
bool is_ref = omp_is_reference (var);
/* First, we copy the descriptor data from the host; then
we update its data to point to the target address. */
tree new_var = lookup_decl (var, ctx);
new_var = DECL_VALUE_EXPR (new_var);
tree v = new_var;
if (is_ref)
{
var = build_fold_indirect_ref (var);
gimplify_expr (&var, &new_body, NULL, is_gimple_val,
fb_rvalue);
v = create_tmp_var_raw (TREE_TYPE (var), get_name (var));
gimple_add_tmp_var (v);
TREE_ADDRESSABLE (v) = 1;
gimple_seq_add_stmt (&new_body,
gimple_build_assign (v, var));
tree rhs = build_fold_addr_expr (v);
gimple_seq_add_stmt (&new_body,
gimple_build_assign (new_var, rhs));
}
else
gimple_seq_add_stmt (&new_body,
gimple_build_assign (new_var, var));
tree v2 = lang_hooks.decls.omp_array_data (unshare_expr (v), false);
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));
}
else if (is_variable_sized (var))
{ {
tree pvar = DECL_VALUE_EXPR (var); tree pvar = DECL_VALUE_EXPR (var);
gcc_assert (TREE_CODE (pvar) == INDIRECT_REF); gcc_assert (TREE_CODE (pvar) == INDIRECT_REF);
......
2019-11-01 Tobias Burnus <tobias@codesourcery.com>
* testsuite/libgomp.fortran/use_device_addr-1.f90 (test_nullptr_1,
test_dummy_opt_nullptr_callee_1): Add present but unallocated test.
* testsuite/libgomp.fortran/use_device_addr-2.f90: Likewise.
* testsuite/libgomp.fortran/use_device_addr-3.f90: New.
* testsuite/libgomp.fortran/use_device_addr-4.f90: New.
* testsuite/testsuite/libgomp.fortran/use_device_ptr-1.f90: New.
2019-10-30 Tobias Burnus <tobias@codesourcery.com> 2019-10-30 Tobias Burnus <tobias@codesourcery.com>
* testsuite/libgomp.fortran/target9.f90: New. * testsuite/libgomp.fortran/target9.f90: New.
......
...@@ -884,8 +884,10 @@ contains ...@@ -884,8 +884,10 @@ contains
real(c_double), pointer :: aa, bb real(c_double), pointer :: aa, bb
real(c_double), pointer :: ee, ff real(c_double), pointer :: ee, ff
type(c_ptr) :: c_aptr, c_bptr, c_eptr, c_fptr real(c_double), allocatable, target :: gg, hh
real(c_double), pointer :: aptr, bptr, eptr, fptr
type(c_ptr) :: c_aptr, c_bptr, c_eptr, c_fptr, c_gptr, c_hptr
real(c_double), pointer :: aptr, bptr, eptr, fptr, gptr, hptr
aa => null() aa => null()
bb => null() bb => null()
...@@ -905,15 +907,29 @@ contains ...@@ -905,15 +907,29 @@ contains
if (c_associated(c_aptr) .or. c_associated(c_bptr)) stop 1 if (c_associated(c_aptr) .or. c_associated(c_bptr)) stop 1
if (associated(aptr) .or. associated(bptr, bb)) stop 1 if (associated(aptr) .or. associated(bptr, bb)) stop 1
call test_dummy_opt_nullptr_callee_1(ee, ff, c_eptr, c_fptr, eptr, fptr) if (allocated(gg)) stop 1
!$omp target data map(tofrom:gg) use_device_addr(gg)
if (c_associated(c_loc(gg))) stop 1
c_gptr = c_loc(gg)
gptr => gg
if (c_associated(c_gptr)) stop 1
if (associated(gptr)) stop 1
if (allocated(gg)) stop 1
!$omp end target data
if (c_associated(c_gptr)) stop 1
if (associated(gptr)) stop 1
if (allocated(gg)) stop 1
call test_dummy_opt_nullptr_callee_1(ee, ff, hh, c_eptr, c_fptr, c_hptr, eptr, fptr, hptr)
end subroutine test_nullptr_1 end subroutine test_nullptr_1
subroutine test_dummy_opt_nullptr_callee_1(ee, ff, c_eptr, c_fptr, eptr, fptr) subroutine test_dummy_opt_nullptr_callee_1(ee, ff, hh, c_eptr, c_fptr, c_hptr, eptr, fptr, hptr)
! scalars ! scalars
real(c_double), optional, pointer :: ee, ff real(c_double), optional, pointer :: ee, ff
real(c_double), optional, allocatable, target :: hh
type(c_ptr), optional :: c_eptr, c_fptr type(c_ptr), optional :: c_eptr, c_fptr, c_hptr
real(c_double), optional, pointer :: eptr, fptr real(c_double), optional, pointer :: eptr, fptr, hptr
if (.not.present(ee) .or. .not.present(ff)) stop 1 if (.not.present(ee) .or. .not.present(ff)) stop 1
if (associated(ee) .or. associated(ff)) stop 1 if (associated(ee) .or. associated(ff)) stop 1
...@@ -932,6 +948,26 @@ contains ...@@ -932,6 +948,26 @@ contains
if (c_associated(c_eptr) .or. c_associated(c_fptr)) stop 1 if (c_associated(c_eptr) .or. c_associated(c_fptr)) stop 1
if (associated(eptr) .or. associated(fptr)) stop 1 if (associated(eptr) .or. associated(fptr)) stop 1
if (associated(ee) .or. associated(ff)) stop 1
if (.not.present(hh)) stop 1
if (allocated(hh)) stop 1
!$omp target data map(tofrom:hh) use_device_addr(hh)
if (.not.present(hh)) stop 1
if (allocated(hh)) stop 1
if (c_associated(c_loc(hh))) stop 1
c_hptr = c_loc(hh)
hptr => hh
if (c_associated(c_hptr)) stop 1
if (associated(hptr)) stop 1
if (allocated(hh)) stop 1
!$omp end target data
if (c_associated(c_hptr)) stop 1
if (associated(hptr)) stop 1
if (allocated(hh)) stop 1
end subroutine test_dummy_opt_nullptr_callee_1 end subroutine test_dummy_opt_nullptr_callee_1
end module test_nullptr end module test_nullptr
......
...@@ -884,8 +884,10 @@ contains ...@@ -884,8 +884,10 @@ contains
real(c_float), pointer :: aa, bb real(c_float), pointer :: aa, bb
real(c_float), pointer :: ee, ff real(c_float), pointer :: ee, ff
type(c_ptr) :: c_aptr, c_bptr, c_eptr, c_fptr real(c_float), allocatable, target :: gg, hh
real(c_float), pointer :: aptr, bptr, eptr, fptr
type(c_ptr) :: c_aptr, c_bptr, c_eptr, c_fptr, c_gptr, c_hptr
real(c_float), pointer :: aptr, bptr, eptr, fptr, gptr, hptr
aa => null() aa => null()
bb => null() bb => null()
...@@ -905,15 +907,29 @@ contains ...@@ -905,15 +907,29 @@ contains
if (c_associated(c_aptr) .or. c_associated(c_bptr)) stop 1 if (c_associated(c_aptr) .or. c_associated(c_bptr)) stop 1
if (associated(aptr) .or. associated(bptr, bb)) stop 1 if (associated(aptr) .or. associated(bptr, bb)) stop 1
call test_dummy_opt_nullptr_callee_1(ee, ff, c_eptr, c_fptr, eptr, fptr) if (allocated(gg)) stop 1
!$omp target data map(tofrom:gg) use_device_addr(gg)
if (c_associated(c_loc(gg))) stop 1
c_gptr = c_loc(gg)
gptr => gg
if (c_associated(c_gptr)) stop 1
if (associated(gptr)) stop 1
if (allocated(gg)) stop 1
!$omp end target data
if (c_associated(c_gptr)) stop 1
if (associated(gptr)) stop 1
if (allocated(gg)) stop 1
call test_dummy_opt_nullptr_callee_1(ee, ff, hh, c_eptr, c_fptr, c_hptr, eptr, fptr, hptr)
end subroutine test_nullptr_1 end subroutine test_nullptr_1
subroutine test_dummy_opt_nullptr_callee_1(ee, ff, c_eptr, c_fptr, eptr, fptr) subroutine test_dummy_opt_nullptr_callee_1(ee, ff, hh, c_eptr, c_fptr, c_hptr, eptr, fptr, hptr)
! scalars ! scalars
real(c_float), optional, pointer :: ee, ff real(c_float), optional, pointer :: ee, ff
real(c_float), optional, allocatable, target :: hh
type(c_ptr), optional :: c_eptr, c_fptr type(c_ptr), optional :: c_eptr, c_fptr, c_hptr
real(c_float), optional, pointer :: eptr, fptr real(c_float), optional, pointer :: eptr, fptr, hptr
if (.not.present(ee) .or. .not.present(ff)) stop 1 if (.not.present(ee) .or. .not.present(ff)) stop 1
if (associated(ee) .or. associated(ff)) stop 1 if (associated(ee) .or. associated(ff)) stop 1
...@@ -932,6 +948,26 @@ contains ...@@ -932,6 +948,26 @@ contains
if (c_associated(c_eptr) .or. c_associated(c_fptr)) stop 1 if (c_associated(c_eptr) .or. c_associated(c_fptr)) stop 1
if (associated(eptr) .or. associated(fptr)) stop 1 if (associated(eptr) .or. associated(fptr)) stop 1
if (associated(ee) .or. associated(ff)) stop 1
if (.not.present(hh)) stop 1
if (allocated(hh)) stop 1
!$omp target data map(tofrom:hh) use_device_addr(hh)
if (.not.present(hh)) stop 1
if (allocated(hh)) stop 1
if (c_associated(c_loc(hh))) stop 1
c_hptr = c_loc(hh)
hptr => hh
if (c_associated(c_hptr)) stop 1
if (associated(hptr)) stop 1
if (allocated(hh)) stop 1
!$omp end target data
if (c_associated(c_hptr)) stop 1
if (associated(hptr)) stop 1
if (allocated(hh)) stop 1
end subroutine test_dummy_opt_nullptr_callee_1 end subroutine test_dummy_opt_nullptr_callee_1
end module test_nullptr end module test_nullptr
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment