Thinking about the patch over night, I have now updated it a bit:
Namely, I only add the "if(present-check)" condition, if the original
variable is dereferenced. There is no need for code like
omp_data_arr.c = c == NULL ? NULL : c;
and then, after the libgomp call, code like "c_2 = c == NULL ? NULL :
omp_data_arr.c;"; due to the libgomp call, the latter cannot even be
optimized away.
Hence, I added 'do_optional_check'; additionally, I had a
libgomp.fortran/use_device_ptr-optional-1.f90 change floating around,
which I included. Otherwise unchanged.
Retested. OK for the trunk?
Cheers,
Tobias
On 11/6/19 4:04 PM, Tobias Burnus wrote:
This patch is based on Kwok's patch, posted as (4/5) at
https://gcc.gnu.org/ml/gcc-patches/2019-07/msg00964.html – which is
targeting OpenACC's use_device* – but it also applies to OpenMP
use_device_{ptr,addr}.
I added an OpenMP test case. It showed that for arguments with value
attribute and for assumed-shape array, one needs to do more — as the
decl cannot be directly used for the is-argument-present check.
(For 'value', a hidden boolean '_' + arg-name is passed in addition;
for assumed-shape arrays, the array descriptor "x" is replaced by the
local variable "x.0" (with "x.0 = x->data") and the original decl "x"
is in GFC_DECL_SAVED_DESCRIPTOR. Especially for assumed-shape arrays,
the new decl cannot be used unconditionally as it is uninitialized
when the argument is absent.)
Bootstrapped and regtested on x86_64-gnu-linux without offloading +
with nvptx.
OK?
Cheers,
Tobias
*The OpenACC test cases are in 5/5 and depend on some other changes.
Submission of {1,missing one line of 2,3,5}/5 is planned next.
PPS: For fully absent-optional support, mapping needs to be handled
for OpenACC (see Kwok's …/5 patches) and OpenMP (which is quite
different on FE level) – and OpenMP also needs changes for the share
clauses.]
2019-11-07 Tobias Burnus <tob...@codesourcery.com>
Kwok Cheung Yeung <k...@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-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.
gcc/fortran/f95-lang.c | 4 ++--
gcc/fortran/trans-decl.c | 3 +--
gcc/fortran/trans-openmp.c | 62 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++-----
gcc/fortran/trans.h | 2 +-
gcc/langhooks-def.h | 4 ++--
gcc/langhooks.h | 13 ++++++++-----
gcc/omp-general.c | 14 ++++++++++----
gcc/omp-general.h | 2 +-
gcc/omp-low.c | 117 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-------------------------
libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-1.f90 | 22 ++++++++++++++++++++++
libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90 | 33 +++++++++++++++++++++++++++++++++
11 files changed, 229 insertions(+), 47 deletions(-)
diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index 0684c3b99cf..c7b592dbfe2 100644
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -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
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index ffa61111316..80ef45d892e 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -2691,9 +2691,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;
}
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 14a3c3e4284..3b82eaf8051 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -58,19 +58,71 @@ 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)
+ 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
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 364efe51d7c..359c7a2561a 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -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);
diff --git a/gcc/langhooks-def.h b/gcc/langhooks-def.h
index 2d3ad9a0a76..4002f281ddd 100644
--- a/gcc/langhooks-def.h
+++ b/gcc/langhooks-def.h
@@ -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, \
diff --git a/gcc/langhooks.h b/gcc/langhooks.h
index 39d3608b5f8..0e451c15ffc 100644
--- a/gcc/langhooks.h
+++ b/gcc/langhooks.h
@@ -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. */
diff --git a/gcc/omp-general.c b/gcc/omp-general.c
index 72a0f20feee..deb4e7996e8 100644
--- a/gcc/omp-general.c
+++ b/gcc/omp-general.c
@@ -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 also_value)
{
- return lang_hooks.decls.omp_is_optional_argument (decl);
+ return lang_hooks.decls.omp_check_optional_argument (decl, also_value);
}
/* Return true if DECL is a reference type. */
diff --git a/gcc/omp-general.h b/gcc/omp-general.h
index fe5c25b08ab..1cf007e3371 100644
--- a/gcc/omp-general.h
+++ b/gcc/omp-general.h
@@ -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 also_value);
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);
diff --git a/gcc/omp-low.c b/gcc/omp-low.c
index fa76ceba33c..dfe67f538fc 100644
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -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,37 @@ 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);
+ if (do_optional_check && omp_check_optional_argument (ovar, true))
+ {
+ 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);
+ tree present = omp_check_optional_argument (ovar, true);
+ 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 +12198,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 +12217,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 +12254,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 +12264,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 +12289,49 @@ 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));
}
+ if (do_optional_check
+ && omp_check_optional_argument (OMP_CLAUSE_DECL (c), true))
+ {
+ 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);
+ tree present = omp_check_optional_argument (OMP_CLAUSE_DECL (c),
+ true);
+ 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,
diff --git a/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-1.f90 b/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-1.f90
index ac69df559c9..e92ee8bf573 100644
--- a/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-1.f90
+++ b/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-1.f90
@@ -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
diff --git a/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90 b/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90
new file mode 100644
index 00000000000..41abf17eede
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90
@@ -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
