MatCat.OpenSource/8sa1-gcc
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Fortran] Support absent optional args with use_device_{ptr,addr}

Browse Source 
2019-11-11  Tobias Burnus  <tobias@codesourcery.com>
            Kwok Cheung Yeung  <kcy@codesourcery.com>

        gcc/
        * langhooks-def.h (LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT):
        Renamed from LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT; update define.
        (LANG_HOOKS_DECLS): Rename also here.
        * langhooks.h (lang_hooks_for_decls): Rename
        omp_is_optional_argument to omp_check_optional_argument; take
        additional bool argument.
        * omp-general.h (omp_check_optional_argument): Likewise.
        * omp-general.h (omp_check_optional_argument): Likewise.
        * omp-low.c (lower_omp_target): Update calls; handle absent
        Fortran optional arguments with USE_DEVICE_ADDR/USE_DEVICE_PTR.

        gcc/fortran/
        * trans-expr.c (gfc_conv_expr_present): Check for DECL_ARTIFICIAL
        for the VALUE hidden argument avoiding -fallow-underscore issues.
        * trans-decl.c (create_function_arglist): Also set
        GFC_DECL_OPTIONAL_ARGUMENT for per-value arguments.
        * f95-lang.c (LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT):
        Renamed from LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT; point
        to gfc_omp_check_optional_argument.
        * trans.h (gfc_omp_check_optional_argument): Subsitutes
        gfc_omp_is_optional_argument declaration.
        * trans-openmp.c (gfc_omp_is_optional_argument): Make static.
        (gfc_omp_check_optional_argument): New function.

        libgomp/
        * testsuite/libgomp.fortran/use_device_ptr-optional-1.f90: Extend.
        * testsuite/libgomp.fortran/use_device_ptr-optional-2.f90: New.


Co-Authored-By: Kwok Cheung Yeung <kcy@codesourcery.com>

From-SVN: r278046
This commit is contained in:
Tobias Burnus 2019-11-11 09:19:29 +00:00 committed by Tobias Burnus
parent bfa1837b01
commit a2c26c5031
15 changed files with 270 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
gcc/ChangeLog
View File

@ -1,3 +1,17 @@
2019-11-11 Tobias Burnus <tobias@codesourcery.com>
Kwok Cheung Yeung <kcy@codesourcery.com>
* langhooks-def.h (LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT):
Renamed from LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT; update define.
(LANG_HOOKS_DECLS): Rename also here.
* langhooks.h (lang_hooks_for_decls): Rename
omp_is_optional_argument to omp_check_optional_argument; take
additional bool argument.
* omp-general.h (omp_check_optional_argument): Likewise.
* omp-general.h (omp_check_optional_argument): Likewise.
* omp-low.c (lower_omp_target): Update calls; handle absent
Fortran optional arguments with USE_DEVICE_ADDR/USE_DEVICE_PTR.
2019-11-11 H.J. Lu <hjl.tools@gmail.com>
PR target/87833

15
gcc/fortran/ChangeLog
View File

@ -1,3 +1,18 @@
2019-11-11 Tobias Burnus <tobias@codesourcery.com>
Kwok Cheung Yeung <kcy@codesourcery.com>
* trans-expr.c (gfc_conv_expr_present): Check for DECL_ARTIFICIAL
for the VALUE hidden argument avoiding -fallow-underscore issues.
* trans-decl.c (create_function_arglist): Also set
GFC_DECL_OPTIONAL_ARGUMENT for per-value arguments.
* f95-lang.c (LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT):
Renamed from LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT; point
to gfc_omp_check_optional_argument.
* trans.h (gfc_omp_check_optional_argument): Subsitutes
gfc_omp_is_optional_argument declaration.
* trans-openmp.c (gfc_omp_is_optional_argument): Make static.
(gfc_omp_check_optional_argument): New function.
2019-11-10 Janne Blomqvist <jb@gcc.gnu.org>
PR fortran/91413

4
gcc/fortran/f95-lang.c
View File

@ -115,7 +115,7 @@ static const struct attribute_spec gfc_attribute_table[] =
#undef LANG_HOOKS_INIT_TS
#undef LANG_HOOKS_OMP_ARRAY_DATA
#undef LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR
#undef LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT
#undef LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT
#undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE
#undef LANG_HOOKS_OMP_PREDETERMINED_SHARING
#undef LANG_HOOKS_OMP_REPORT_DECL
@ -150,7 +150,7 @@ static const struct attribute_spec gfc_attribute_table[] =
#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_OPTIONAL_ARGUMENT gfc_omp_is_optional_argument
#define LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT gfc_omp_check_optional_argument
#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

3
gcc/fortran/trans-decl.c
View File

@ -2692,9 +2692,8 @@ 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 && !f->sym->attr.value)
if (f->sym->attr.optional)
{
/* With value, the argument is passed as is. */
gfc_allocate_lang_decl (parm);
GFC_DECL_OPTIONAL_ARGUMENT (parm) = 1;
}

3
gcc/fortran/trans-expr.c
View File

@ -1725,7 +1725,8 @@ gfc_conv_expr_present (gfc_symbol * sym)
/* Walk function argument list to find hidden arg. */
cond = DECL_ARGUMENTS (DECL_CONTEXT (decl));
for ( ; cond != NULL_TREE; cond = TREE_CHAIN (cond))
if (DECL_NAME (cond) == tree_name)
if (DECL_NAME (cond) == tree_name
&& DECL_ARTIFICIAL (cond))
break;
gcc_assert (cond);

63
gcc/fortran/trans-openmp.c
View File

@ -58,19 +58,72 @@ gfc_omp_is_allocatable_or_ptr (const_tree 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. */
/* True if the argument is an optional argument; except that false is also
returned for arguments with the value attribute (nonpointers) and for
assumed-shape variables (decl is a local variable containing arg->data). */
bool
static bool
gfc_omp_is_optional_argument (const_tree decl)
{
return (TREE_CODE (decl) == PARM_DECL
&& DECL_LANG_SPECIFIC (decl)
&& TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE
&& GFC_DECL_OPTIONAL_ARGUMENT (decl));
}
/* Check whether this DECL belongs to a Fortran optional argument.
With 'for_present_check' set to false, decls which are optional parameters
themselve are returned as tree - or a NULL_TREE otherwise. Those decls are
always pointers. With 'for_present_check' set to true, the decl for checking
whether an argument is present is returned; for arguments with value
attribute this is the hidden argument and of BOOLEAN_TYPE. If the decl is
unrelated to optional arguments, NULL_TREE is returned. */
tree
gfc_omp_check_optional_argument (tree decl, bool for_present_check)
{
if (!for_present_check)
return gfc_omp_is_optional_argument (decl) ? decl : NULL_TREE;
if (!DECL_LANG_SPECIFIC (decl))
return NULL_TREE;
/* For assumed-shape arrays, a local decl with arg->data is used. */
if (TREE_CODE (decl) != PARM_DECL
&& (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))
|| GFC_ARRAY_TYPE_P (TREE_TYPE (decl))))
decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
if (TREE_CODE (decl) != PARM_DECL
|| !DECL_LANG_SPECIFIC (decl)
|| !GFC_DECL_OPTIONAL_ARGUMENT (decl))
return NULL_TREE;
/* For VALUE, the scalar variable is passed as is but a hidden argument
denotes the value. Cf. trans-expr.c. */
if (TREE_CODE (TREE_TYPE (decl)) != POINTER_TYPE)
{
char name[GFC_MAX_SYMBOL_LEN + 2];
tree tree_name;
name[0] = '_';
strcpy (&name[1], IDENTIFIER_POINTER (DECL_NAME (decl)));
tree_name = get_identifier (name);
/* Walk function argument list to find the hidden arg. */
decl = DECL_ARGUMENTS (DECL_CONTEXT (decl));
for ( ; decl != NULL_TREE; decl = TREE_CHAIN (decl))
if (DECL_NAME (decl) == tree_name
&& DECL_ARTIFICIAL (decl))
break;
gcc_assert (decl);
return decl;
}
return 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

2
gcc/fortran/trans.h
View File

@ -787,7 +787,7 @@ 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);
tree gfc_omp_check_optional_argument (tree, bool);
tree gfc_omp_array_data (tree, bool);
bool gfc_omp_privatize_by_reference (const_tree);
enum omp_clause_default_kind gfc_omp_predetermined_sharing (tree);

4
gcc/langhooks-def.h
View File

@ -241,7 +241,7 @@ extern tree lhd_unit_size_without_reusable_padding (tree);
#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_OPTIONAL_ARGUMENT hook_bool_const_tree_false
#define LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT hook_tree_tree_bool_null
#define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE hook_bool_const_tree_false
#define LANG_HOOKS_OMP_PREDETERMINED_SHARING lhd_omp_predetermined_sharing
#define LANG_HOOKS_OMP_REPORT_DECL lhd_pass_through_t
@ -269,7 +269,7 @@ extern tree lhd_unit_size_without_reusable_padding (tree);
LANG_HOOKS_DECL_OK_FOR_SIBCALL, \
LANG_HOOKS_OMP_ARRAY_DATA, \
LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR, \
LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT, \
LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT, \
LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE, \
LANG_HOOKS_OMP_PREDETERMINED_SHARING, \
LANG_HOOKS_OMP_REPORT_DECL, \

13
gcc/langhooks.h
View File

@ -235,11 +235,14 @@ struct lang_hooks_for_decls
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);
/* Check whether this DECL belongs to a Fortran optional argument.
With 'for_present_check' set to false, decls which are optional parameters
themselve are returned as tree - or a NULL_TREE otherwise. Those decls are
always pointers. With 'for_present_check' set to true, the decl for
checking whether an argument is present is returned; for arguments with
value attribute this is the hidden argument and of BOOLEAN_TYPE. If the
decl is unrelated to optional arguments, NULL_TREE is returned. */
tree (*omp_check_optional_argument) (tree, bool);
/* True if OpenMP should privatize what this DECL points to rather
than the DECL itself. */

14
gcc/omp-general.c
View File

@ -63,12 +63,18 @@ 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. */
/* Check whether this DECL belongs to a Fortran optional argument.
With 'for_present_check' set to false, decls which are optional parameters
themselve are returned as tree - or a NULL_TREE otherwise. Those decls are
always pointers. With 'for_present_check' set to true, the decl for checking
whether an argument is present is returned; for arguments with value
attribute this is the hidden argument and of BOOLEAN_TYPE. If the decl is
unrelated to optional arguments, NULL_TREE is returned. */
bool
omp_is_optional_argument (tree decl)
tree
omp_check_optional_argument (tree decl, bool for_present_check)
{
return lang_hooks.decls.omp_is_optional_argument (decl);
return lang_hooks.decls.omp_check_optional_argument (decl, for_present_check);
}
/* Return true if DECL is a reference type. */

2
gcc/omp-general.h
View File

@ -74,7 +74,7 @@ struct omp_for_data
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 tree omp_check_optional_argument (tree decl, bool for_present_check);
extern bool omp_is_reference (tree decl);
extern void omp_adjust_for_condition (location_t loc, enum tree_code *cond_code,
tree *n2, tree v, tree step);

120
gcc/omp-low.c
View File

@ -11796,12 +11796,12 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
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)))
&& omp_check_optional_argument (var, false)))
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)))
&& !omp_check_optional_argument (var, false)))
var = build_fold_addr_expr (var);
gimplify_assign (x, var, &ilist);
}
@ -11975,6 +11975,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
case OMP_CLAUSE_USE_DEVICE_PTR:
case OMP_CLAUSE_USE_DEVICE_ADDR:
case OMP_CLAUSE_IS_DEVICE_PTR:
bool do_optional_check;
do_optional_check = false;
ovar = OMP_CLAUSE_DECL (c);
var = lookup_decl_in_outer_ctx (ovar, ctx);
@ -11996,7 +11998,10 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
}
type = TREE_TYPE (ovar);
if (lang_hooks.decls.omp_array_data (ovar, true))
var = lang_hooks.decls.omp_array_data (ovar, false);
{
var = lang_hooks.decls.omp_array_data (ovar, false);
do_optional_check = true;
}
else if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR
&& !omp_is_reference (ovar)
&& !omp_is_allocatable_or_ptr (ovar))
@ -12005,7 +12010,7 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
else
{
if (omp_is_reference (ovar)
|| omp_is_optional_argument (ovar)
|| omp_check_optional_argument (ovar, false)
|| omp_is_allocatable_or_ptr (ovar))
{
type = TREE_TYPE (type);
@ -12014,11 +12019,39 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
&& !omp_is_allocatable_or_ptr (ovar))
|| (omp_is_reference (ovar)
&& omp_is_allocatable_or_ptr (ovar))))
var = build_simple_mem_ref (var);
{
var = build_simple_mem_ref (var);
do_optional_check = true;
}
var = fold_convert (TREE_TYPE (x), var);
}
}
gimplify_assign (x, var, &ilist);
tree present;
present = (do_optional_check
? omp_check_optional_argument (ovar, true) : NULL_TREE);
if (present)
{
tree null_label = create_artificial_label (UNKNOWN_LOCATION);
tree notnull_label = create_artificial_label (UNKNOWN_LOCATION);
tree opt_arg_label = create_artificial_label (UNKNOWN_LOCATION);
tree new_x = unshare_expr (x);
gimplify_expr (&present, &ilist, NULL, is_gimple_val,
fb_rvalue);
gcond *cond = gimple_build_cond_from_tree (present,
notnull_label,
null_label);
gimple_seq_add_stmt (&ilist, cond);
gimple_seq_add_stmt (&ilist, gimple_build_label (null_label));
gimplify_assign (new_x, null_pointer_node, &ilist);
gimple_seq_add_stmt (&ilist, gimple_build_goto (opt_arg_label));
gimple_seq_add_stmt (&ilist,
gimple_build_label (notnull_label));
gimplify_assign (x, var, &ilist);
gimple_seq_add_stmt (&ilist,
gimple_build_label (opt_arg_label));
}
else
gimplify_assign (x, var, &ilist);
s = size_int (0);
purpose = size_int (map_idx++);
CONSTRUCTOR_APPEND_ELT (vsize, purpose, s);
@ -12167,8 +12200,13 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
case OMP_CLAUSE_USE_DEVICE_PTR:
case OMP_CLAUSE_USE_DEVICE_ADDR:
case OMP_CLAUSE_IS_DEVICE_PTR:
var = OMP_CLAUSE_DECL (c);
tree new_var;
gimple_seq assign_body;
bool is_array_data;
bool do_optional_check;
assign_body = NULL;
do_optional_check = false;
var = OMP_CLAUSE_DECL (c);
is_array_data = lang_hooks.decls.omp_array_data (var, true) != NULL;
if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_IS_DEVICE_PTR)
@ -12181,34 +12219,35 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
if (is_array_data)
{
bool is_ref = omp_is_reference (var);
do_optional_check = true;
/* 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 = 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,
gimplify_expr (&var, &assign_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_seq_add_stmt (&assign_body,
gimple_build_assign (v, var));
tree rhs = build_fold_addr_expr (v);
gimple_seq_add_stmt (&new_body,
gimple_seq_add_stmt (&assign_body,
gimple_build_assign (new_var, rhs));
}
else
gimple_seq_add_stmt (&new_body,
gimple_seq_add_stmt (&assign_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,
gimplify_expr (&x, &assign_body, NULL, is_gimple_val, fb_rvalue);
gimple_seq_add_stmt (&assign_body,
gimple_build_assign (v2, x));
}
else if (is_variable_sized (var))
@ -12217,9 +12256,9 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
gcc_assert (TREE_CODE (pvar) == INDIRECT_REF);
pvar = TREE_OPERAND (pvar, 0);
gcc_assert (DECL_P (pvar));
tree new_var = lookup_decl (pvar, ctx);
gimplify_expr (&x, &new_body, NULL, is_gimple_val, fb_rvalue);
gimple_seq_add_stmt (&new_body,
new_var = lookup_decl (pvar, ctx);
gimplify_expr (&x, &assign_body, NULL, is_gimple_val, fb_rvalue);
gimple_seq_add_stmt (&assign_body,
gimple_build_assign (new_var, x));
}
else if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR
@ -12227,19 +12266,19 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
&& !omp_is_allocatable_or_ptr (var))
|| TREE_CODE (TREE_TYPE (var)) == ARRAY_TYPE)
{
tree new_var = lookup_decl (var, ctx);
new_var = lookup_decl (var, ctx);
new_var = DECL_VALUE_EXPR (new_var);
gcc_assert (TREE_CODE (new_var) == MEM_REF);
new_var = TREE_OPERAND (new_var, 0);
gcc_assert (DECL_P (new_var));
gimplify_expr (&x, &new_body, NULL, is_gimple_val, fb_rvalue);
gimple_seq_add_stmt (&new_body,
gimplify_expr (&x, &assign_body, NULL, is_gimple_val, fb_rvalue);
gimple_seq_add_stmt (&assign_body,
gimple_build_assign (new_var, x));
}
else
{
tree type = TREE_TYPE (var);
tree new_var = lookup_decl (var, ctx);
new_var = lookup_decl (var, ctx);
if (omp_is_reference (var))
{
type = TREE_TYPE (type);
@ -12252,19 +12291,50 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
gimple_add_tmp_var (v);
TREE_ADDRESSABLE (v) = 1;
x = fold_convert (type, x);
gimplify_expr (&x, &new_body, NULL, is_gimple_val,
gimplify_expr (&x, &assign_body, NULL, is_gimple_val,
fb_rvalue);
gimple_seq_add_stmt (&new_body,
gimple_seq_add_stmt (&assign_body,
gimple_build_assign (v, x));
x = build_fold_addr_expr (v);
do_optional_check = true;
}
}
new_var = DECL_VALUE_EXPR (new_var);
x = fold_convert (TREE_TYPE (new_var), x);
gimplify_expr (&x, &new_body, NULL, is_gimple_val, fb_rvalue);
gimple_seq_add_stmt (&new_body,
gimplify_expr (&x, &assign_body, NULL, is_gimple_val, fb_rvalue);
gimple_seq_add_stmt (&assign_body,
gimple_build_assign (new_var, x));
}
tree present;
present = (do_optional_check
? omp_check_optional_argument (OMP_CLAUSE_DECL (c), true)
: NULL_TREE);
if (present)
{
tree null_label = create_artificial_label (UNKNOWN_LOCATION);
tree notnull_label = create_artificial_label (UNKNOWN_LOCATION);
tree opt_arg_label = create_artificial_label (UNKNOWN_LOCATION);
glabel *null_glabel = gimple_build_label (null_label);
glabel *notnull_glabel = gimple_build_label (notnull_label);
ggoto *opt_arg_ggoto = gimple_build_goto (opt_arg_label);
gimplify_expr (&x, &new_body, NULL, is_gimple_val,
fb_rvalue);
gimplify_expr (&present, &new_body, NULL, is_gimple_val,
fb_rvalue);
gcond *cond = gimple_build_cond_from_tree (present,
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, &new_body);
gimple_seq_add_stmt (&new_body, opt_arg_ggoto);
gimple_seq_add_stmt (&new_body, notnull_glabel);
gimple_seq_add_seq (&new_body, assign_body);
gimple_seq_add_stmt (&new_body,
gimple_build_label (opt_arg_label));
}
else
gimple_seq_add_seq (&new_body, assign_body);
break;
}
/* Handle GOMP_MAP_FIRSTPRIVATE_{POINTER,REFERENCE} in second pass,

6
libgomp/ChangeLog
View File

@ -1,3 +1,9 @@
2019-11-11 Tobias Burnus <tobias@codesourcery.com>
Kwok Cheung Yeung <kcy@codesourcery.com>
* testsuite/libgomp.fortran/use_device_ptr-optional-1.f90: Extend.
* testsuite/libgomp.fortran/use_device_ptr-optional-2.f90: New.
2019-11-11 Thomas Schwinge <thomas@codesourcery.com>
* testsuite/libgomp.fortran/target9.f90: Specify 'dg-do run'.

22
libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-1.f90
View File

@ -11,6 +11,9 @@ program test_it
ptr_null => null()
call bar(ptr_null)
call foo_absent()
call bar_absent()
contains
subroutine foo(ii)
integer, pointer, optional :: ii
@ -34,4 +37,23 @@ contains
if (associated(jj)) stop 8
!$omp end target data
end subroutine bar
subroutine foo_absent(ii)
integer, pointer, optional :: ii
if (present(ii)) STOP 31
!$omp target data map(to:ixx) use_device_ptr(ii)
if (present(ii)) STOP 32
!$omp end target data
end subroutine foo_absent
! For bar, it is assumed that a NULL ptr on the host maps to NULL on the device
subroutine bar_absent(jj)
integer, pointer, optional :: jj
if (present(jj)) STOP 41
!$omp target data map(to:ixx) use_device_ptr(jj)
if (present(jj)) STOP 42
!$omp end target data
end subroutine bar_absent
end program test_it

33
libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90 Normal file
View File

@ -0,0 +1,33 @@
! Check whether absent optional arguments are properly
! handled with use_device_{addr,ptr}.
program main
implicit none (type, external)
call foo()
contains
subroutine foo(v, w, x, y, z)
integer, target, optional, value :: v
integer, target, optional :: w
integer, target, optional :: x(:)
integer, target, optional, allocatable :: y
integer, target, optional, allocatable :: z(:)
integer :: d
!$omp target data map(d) use_device_addr(v, w, x, y, z)
if(present(v)) stop 1
if(present(w)) stop 2
if(present(x)) stop 3
if(present(y)) stop 4
if(present(z)) stop 5
!$omp end target data
! Using 'v' in use_device_ptr gives an ICE
! TODO: Find out what the OpenMP spec permits for use_device_ptr
!$omp target data map(d) use_device_ptr(w, x, y, z)
if(present(w)) stop 6
if(present(x)) stop 7
if(present(y)) stop 8
if(present(z)) stop 9
!$omp end target data
end subroutine foo
end program main