Hi all,
[For those who got it twice, I actually forget to include the mailing
lists in the first round. Ups.]
this patch fixes the bug that with "optional" the wrong pointer is used
with "use_device_ptr"; the bug is already observable without doing
actual offloading.
Namely, "present(ptr)" checks whether the passed argument is != NULL.
While using "ptr" – e.g. as "associated(ptr)" – workes the (once)
dereferenced dummy argument, which matches the actual argument.
The test case is written such that the pointer passed to
"use_device_ptr" is present.*
Built and regtested on x86_64-gnu-linux without device; I am currently
doing a full bootstrap + regtesting and want to test it also with nvptx
offloading. Assuming no issue pops up:
OK for the trunk?
Regarding the patches:
* The first tiny patch is mine
* The second patch which added the lang_hook omp_is_optional_argument is
the one posted at https://gcc.gnu.org/ml/gcc-patches/2019-07/msg01743.html
This one was approved by Jakub and I only did two things:
(a) re-diff-ed it (trivial as fuzzy worked)
(b) I followed both suggestions of Jakub (PARAM_DECL + adding "( )")
[Motivation of this patch is – besides fixing an issue – to get the
second patch it, which makes it easier to consolidate some other bits
and pieces.]
Thanks,
Tobias
* OpenACC (Sec. 2.17) demands that a variable 'arg' in "clauses has no
effect at runtime if PRESENT(arg) is .false." – Hence, one needs to go
beyond this patch. That's done in the patch series at
https://gcc.gnu.org/ml/gcc-patches/2019-07/threads.html#00960 – the
patch lang_hook patch of this email is 2/5 of that series.
gcc/
* omp-low.c (lower_omp_target): Dereference optional argument
to work with the right pointer.
gcc/testsuite/
* libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-1.f90: New.
diff --git a/gcc/omp-low.c b/gcc/omp-low.c
index a0e5041d3f2..ca7dfdb83a1 100644
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -11870,7 +11870,7 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
var = build_fold_addr_expr (var);
else
{
- if (omp_is_reference (ovar))
+ if (omp_is_reference (ovar) || omp_is_optional_argument (ovar))
{
type = TREE_TYPE (type);
if (TREE_CODE (type) != ARRAY_TYPE
diff --git a/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-1.f90 b/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-1.f90
new file mode 100644
index 00000000000..93c61216034
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-1.f90
@@ -0,0 +1,36 @@
+! Test whether use_device_ptr properly handles OPTIONAL arguments
+! (Only case of present arguments is tested)
+program test_it
+ implicit none
+ integer, target :: ixx
+ integer, pointer :: ptr_i, ptr_null
+
+ ptr_i => ixx
+ call foo(ptr_i)
+
+ ptr_null => null()
+ call bar(ptr_null)
+contains
+ subroutine foo(ii)
+ integer, pointer, optional :: ii
+
+ if (.not.present(ii)) call abort()
+ if (.not.associated(ii, ixx)) call abort()
+ !$omp target data map(to:ixx) use_device_ptr(ii)
+ if (.not.present(ii)) call abort()
+ if (.not.associated(ii)) call abort()
+ !$omp end target data
+ end subroutine foo
+
+ ! For bar, it is assumed that a NULL ptr on the host maps to NULL on the device
+ subroutine bar(jj)
+ integer, pointer, optional :: jj
+
+ if (.not.present(jj)) call abort()
+ if (associated(jj)) call abort()
+ !$omp target data map(to:ixx) use_device_ptr(jj)
+ if (.not.present(jj)) call abort()
+ if (associated(jj)) call abort()
+ !$omp end target data
+ end subroutine bar
+end program test_it
Patch from:
https://gcc.gnu.org/ml/gcc-patches/2019-07/msg01743.html
Re: [PATCH 2/5, OpenACC] Support Fortran optional arguments in the firstprivate clause
Changes: Rediffed, review changes added (added parentheses, PARM_DECL check)
gcc/fortran/
* f95-lang.c (LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT): Define to
gfc_omp_is_optional_argument.
* trans-decl.c (create_function_arglist): Set
GFC_DECL_OPTIONAL_ARGUMENT in the generated decl if the parameter is
optional.
* trans-openmp.c (gfc_omp_is_optional_argument): New.
(gfc_omp_privatize_by_reference): Return true if the decl is an
optional pass-by-reference argument.
* trans.h (gfc_omp_is_optional_argument): New declaration.
(lang_decl): Add new optional_arg field.
(GFC_DECL_OPTIONAL_ARGUMENT): New macro.
gcc/
* langhooks-def.h (LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT): Default to
false.
(LANG_HOOKS_DECLS): Add LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT.
* langhooks.h (omp_is_optional_argument): New hook.
* omp-general.c (omp_is_optional_argument): New.
* omp-general.h (omp_is_optional_argument): New declaration.
* omp-low.c (lower_omp_target): Create temporary for received value
and take the address for new_var if the original variable was a
DECL_BY_REFERENCE. Use size of referenced object when a
pass-by-reference optional argument used as argument to firstprivate.
gcc/fortran/f95-lang.c | 2 ++
gcc/fortran/trans-decl.c | 5 +++++
gcc/fortran/trans-openmp.c | 13 +++++++++++++
gcc/fortran/trans.h | 4 ++++
gcc/langhooks-def.h | 2 ++
gcc/langhooks.h | 3 +++
gcc/omp-general.c | 8 ++++++++
gcc/omp-general.h | 1 +
gcc/omp-low.c | 3 ++-
9 files changed, 40 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index 6b9f490d2bb..2467cd968af 100644
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -113,6 +113,7 @@ static const struct attribute_spec gfc_attribute_table[] =
#undef LANG_HOOKS_TYPE_FOR_MODE
#undef LANG_HOOKS_TYPE_FOR_SIZE
#undef LANG_HOOKS_INIT_TS
+#undef LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT
#undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE
#undef LANG_HOOKS_OMP_PREDETERMINED_SHARING
#undef LANG_HOOKS_OMP_REPORT_DECL
@@ -145,6 +146,7 @@ static const struct attribute_spec gfc_attribute_table[] =
#define LANG_HOOKS_TYPE_FOR_MODE gfc_type_for_mode
#define LANG_HOOKS_TYPE_FOR_SIZE gfc_type_for_size
#define LANG_HOOKS_INIT_TS gfc_init_ts
+#define LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT gfc_omp_is_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 c2c5d9d1b6a..a113f08e26b 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -2687,6 +2687,11 @@ 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)
+ {
+ gfc_allocate_lang_decl (parm);
+ GFC_DECL_OPTIONAL_ARGUMENT (parm) = 1;
+ }
gfc_finish_decl (parm);
gfc_finish_decl_attrs (parm, &f->sym->attr);
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index b4c77aebf4d..88ecc331166 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -47,6 +47,15 @@ along with GCC; see the file COPYING3. If not see
int ompws_flags;
+/* True if OpenMP should treat this DECL as an optional argument. */
+
+bool
+gfc_omp_is_optional_argument (const_tree decl)
+{
+ return (TREE_CODE (decl) == PARM_DECL && DECL_LANG_SPECIFIC (decl)
+ && GFC_DECL_OPTIONAL_ARGUMENT (decl));
+}
+
/* True if OpenMP should privatize what this DECL points to rather
than the DECL itself. */
@@ -59,6 +68,10 @@ gfc_omp_privatize_by_reference (const_tree decl)
&& (!DECL_ARTIFICIAL (decl) || TREE_CODE (decl) == PARM_DECL))
return true;
+ if (TREE_CODE (type) == POINTER_TYPE
+ && gfc_omp_is_optional_argument (decl))
+ return true;
+
if (TREE_CODE (type) == POINTER_TYPE)
{
/* Array POINTER/ALLOCATABLE have aggregate types, all user variables
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 6ebb71de152..405e88dd1c4 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -786,6 +786,7 @@ struct array_descr_info;
bool gfc_get_array_descr_info (const_tree, struct array_descr_info *);
/* In trans-openmp.c */
+bool gfc_omp_is_optional_argument (const_tree);
bool gfc_omp_privatize_by_reference (const_tree);
enum omp_clause_default_kind gfc_omp_predetermined_sharing (tree);
tree gfc_omp_report_decl (tree);
@@ -999,6 +1000,7 @@ struct GTY(()) lang_decl {
tree token, caf_offset;
unsigned int scalar_allocatable : 1;
unsigned int scalar_pointer : 1;
+ unsigned int optional_arg : 1;
};
@@ -1013,6 +1015,8 @@ struct GTY(()) lang_decl {
(DECL_LANG_SPECIFIC (node)->scalar_allocatable)
#define GFC_DECL_SCALAR_POINTER(node) \
(DECL_LANG_SPECIFIC (node)->scalar_pointer)
+#define GFC_DECL_OPTIONAL_ARGUMENT(node) \
+ (DECL_LANG_SPECIFIC (node)->optional_arg)
#define GFC_DECL_GET_SCALAR_ALLOCATABLE(node) \
(DECL_LANG_SPECIFIC (node) ? GFC_DECL_SCALAR_ALLOCATABLE (node) : 0)
#define GFC_DECL_GET_SCALAR_POINTER(node) \
diff --git a/gcc/langhooks-def.h b/gcc/langhooks-def.h
index a059841b3df..55d5fe01495 100644
--- a/gcc/langhooks-def.h
+++ b/gcc/langhooks-def.h
@@ -236,6 +236,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_POST_COMPILATION_PARSING_CLEANUPS NULL
#define LANG_HOOKS_DECL_OK_FOR_SIBCALL lhd_decl_ok_for_sibcall
+#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_PREDETERMINED_SHARING lhd_omp_predetermined_sharing
#define LANG_HOOKS_OMP_REPORT_DECL lhd_pass_through_t
@@ -261,6 +262,7 @@ extern tree lhd_unit_size_without_reusable_padding (tree);
LANG_HOOKS_WARN_UNUSED_GLOBAL_DECL, \
LANG_HOOKS_POST_COMPILATION_PARSING_CLEANUPS, \
LANG_HOOKS_DECL_OK_FOR_SIBCALL, \
+ LANG_HOOKS_OMP_IS_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 a45579b3325..9d2714a5b1d 100644
--- a/gcc/langhooks.h
+++ b/gcc/langhooks.h
@@ -222,6 +222,9 @@ struct lang_hooks_for_decls
/* True if this decl may be called via a sibcall. */
bool (*ok_for_sibcall) (const_tree);
+ /* True if OpenMP should treat DECL as a Fortran optional argument. */
+ bool (*omp_is_optional_argument) (const_tree);
+
/* True if OpenMP should privatize what this DECL points to rather
than the DECL itself. */
bool (*omp_privatize_by_reference) (const_tree);
diff --git a/gcc/omp-general.c b/gcc/omp-general.c
index 66be94f6ff9..5ef6e251698 100644
--- a/gcc/omp-general.c
+++ b/gcc/omp-general.c
@@ -48,6 +48,14 @@ omp_find_clause (tree clauses, enum omp_clause_code kind)
return NULL_TREE;
}
+/* Return true if DECL is a Fortran optional argument. */
+
+bool
+omp_is_optional_argument (tree decl)
+{
+ return lang_hooks.decls.omp_is_optional_argument (decl);
+}
+
/* Return true if DECL is a reference type. */
bool
diff --git a/gcc/omp-general.h b/gcc/omp-general.h
index 80d42aff3c8..bbaa7b11707 100644
--- a/gcc/omp-general.h
+++ b/gcc/omp-general.h
@@ -73,6 +73,7 @@ struct omp_for_data
#define OACC_FN_ATTRIB "oacc function"
extern tree omp_find_clause (tree clauses, enum omp_clause_code kind);
+extern bool omp_is_optional_argument (tree decl);
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 5db182c6841..a0e5041d3f2 100644
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -11395,7 +11395,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
{
gcc_assert (is_gimple_omp_oacc (ctx->stmt));
if (omp_is_reference (new_var)
- && TREE_CODE (TREE_TYPE (new_var)) != POINTER_TYPE)
+ && (TREE_CODE (TREE_TYPE (new_var)) != POINTER_TYPE
+ || DECL_BY_REFERENCE (var)))
{
/* Create a local object to hold the instance
value. */