This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch][OpenMP][Fortran] Support absent optional args with use_device_{ptr,addr} (+ OpenACC's use_device clause)
- From: Tobias Burnus <tobias at codesourcery dot com>
- To: Jakub Jelinek <jakub at redhat dot com>, gcc-patches <gcc-patches at gcc dot gnu dot org>, fortran <fortran at gcc dot gnu dot org>
- Cc: Thomas Schwinge <thomas at codesourcery dot com>
- Date: Wed, 6 Nov 2019 16:04:40 +0100
- Subject: [Patch][OpenMP][Fortran] Support absent optional args with use_device_{ptr,addr} (+ OpenACC's use_device clause)
- Ironport-sdr: 4yr4vN6X3hI0pJt3NZa7XqwLnCh/g8fw6kGzq9gG4Be+FXSa4AMnGJWaqCgAwJ2MEwteoGCo5E TLjwSLX+r/obJeceDn3H/kYVhcxtL4Nrzx8v4D88osTvIZzaE710wrOz4KSxa8NAh7z7KnqinE EIdN2lUaepS64Mb9/rxKuXnhKAD9AGwEoRloRbwgLyJ0jKW8PzGiO2zxqzJXJOagT12sUAMucc YbteRfOk+MXwkifYUFckD6GSP/Lm6xG0IOaoMX/Tb+nc2SX+fVilAA2H1+mXcoit2QCcLIeRzk TVU=
- Ironport-sdr: 1BQfA/PreZGkfdORv9dTSO2xMk7+tABxEaLIhfJUV1uNBLDclGV9Jym5sJs64msrmfui9KY3gE EK9+K9R3vc2ezVQRTw1pTJNnlV/qGZXgL5RjF1Lp7nUNrPAiKg9U8hKum/IjLZkonL+JmFXi2X 1nZoTrbW9AY6Ju629FDttFn6Ghmj2Iil/ktiN83YE5dEXPwkXEkobQW2K7ZXUqbjLBVFlJXpVR Ho+OY9clqHAtTwbnWE+0dBUNBciGemuQMMz8clGwSv0wUzp6w/b7qqU5biS1Sjj+83L3HM01eQ KGE=
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-06 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-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-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 | 98 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++----------------------
libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90 | 33 +++++++++++++++++++++++++++++++++
10 files changed, 191 insertions(+), 44 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..ba39ccc390c 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);
}
@@ -12005,7 +12005,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);
@@ -12018,7 +12018,30 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
var = fold_convert (TREE_TYPE (x), var);
}
}
- gimplify_assign (x, var, &ilist);
+ if (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);
@@ -12168,6 +12191,9 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
case OMP_CLAUSE_USE_DEVICE_ADDR:
case OMP_CLAUSE_IS_DEVICE_PTR:
var = OMP_CLAUSE_DECL (c);
+ tree new_var;
+ gimple_seq assign_body;
+ assign_body = NULL;
bool is_array_data;
is_array_data = lang_hooks.decls.omp_array_data (var, true) != NULL;
@@ -12183,32 +12209,32 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
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 = 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 +12243,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 +12253,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 +12278,47 @@ 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);
}
}
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 (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-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