This patch fixes a case where POINTER attribute arrays are deep copied when not
supposed to.
This creates a new langhook 'omp_array_data_privatize' to differentiate cases
in certain
places during omp-low.
Still under final testing. Okay for mainline if everything passes?
Thanks,
Chung-Lin
gcc/fortran/ChangeLog:
* f95-lang.cc (LANG_HOOKS_OMP_ARRAY_DATA_PRIVATIZE): Define as
gfc_omp_array_data_privatize.
* trans-openmp.cc (gfc_omp_array_data_privatize): New function.
* trans.h (gfc_omp_array_data_privatize): New declaration.
gcc/ChangeLog:
* langhooks-def.h (LANG_HOOKS_OMP_ARRAY_DATA_PRIVATIZE): Define.
* langhooks.h (struct lang_hooks_for_decls): Define
omp_array_data_privatize hook.
* omp-low.cc (scan_sharing_clauses): Add new calls to
lang_hooks.decls.omp_array_data_privatize,
(lower_omp_target): Likewise.
libgomp/ChangeLog:
* testsuite/libgomp.fortran/pr122910.f90: New test.
diff --git a/gcc/fortran/f95-lang.cc b/gcc/fortran/f95-lang.cc
index 45aab34865f..12ab1d251da 100644
--- a/gcc/fortran/f95-lang.cc
+++ b/gcc/fortran/f95-lang.cc
@@ -135,6 +135,7 @@ gfc_get_sarif_source_language (const char *)
#undef LANG_HOOKS_TYPE_FOR_SIZE
#undef LANG_HOOKS_INIT_TS
#undef LANG_HOOKS_OMP_ARRAY_DATA
+#undef LANG_HOOKS_OMP_ARRAY_DATA_PRIVATIZE
#undef LANG_HOOKS_OMP_ARRAY_SIZE
#undef LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR
#undef LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT
@@ -178,6 +179,7 @@ gfc_get_sarif_source_language (const char *)
#define LANG_HOOKS_TYPE_FOR_SIZE gfc_type_for_size
#define LANG_HOOKS_INIT_TS gfc_init_ts
#define LANG_HOOKS_OMP_ARRAY_DATA gfc_omp_array_data
+#define LANG_HOOKS_OMP_ARRAY_DATA_PRIVATIZE gfc_omp_array_data_privatize
#define LANG_HOOKS_OMP_ARRAY_SIZE gfc_omp_array_size
#define LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR gfc_omp_is_allocatable_or_ptr
#define LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT gfc_omp_check_optional_argument
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index b9c09d114b7..e64fa82a238 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -176,6 +176,24 @@ gfc_omp_array_data (tree decl, bool type_only)
return decl;
}
+/* Returns true if it is an array descriptor where the data is to be copied
+ and privatized. Assumes the above 'omp_array_data' to already be true
+ (hence the assertion of descriptor type here). */
+
+bool
+gfc_omp_array_data_privatize (tree decl)
+{
+ tree type = TREE_TYPE (decl);
+
+ if (POINTER_TYPE_P (type))
+ type = TREE_TYPE (type);
+
+ gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
+
+ return (GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_POINTER
+ && GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_POINTER_CONT);
+}
+
/* Return the byte-size of the passed array descriptor. */
tree
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index f97fefd2ac0..0bdee5820fd 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -827,6 +827,7 @@ tree gfc_omp_call_is_alloc (tree);
bool gfc_omp_is_allocatable_or_ptr (const_tree);
tree gfc_omp_check_optional_argument (tree, bool);
tree gfc_omp_array_data (tree, bool);
+bool gfc_omp_array_data_privatize (tree);
tree gfc_omp_array_size (tree, gimple_seq *);
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 fc409ec08b9..33a99266187 100644
--- a/gcc/langhooks-def.h
+++ b/gcc/langhooks-def.h
@@ -263,6 +263,7 @@ extern tree lhd_unit_size_without_reusable_padding (tree);
#define LANG_HOOKS_POST_COMPILATION_PARSING_CLEANUPS NULL
#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_ARRAY_DATA_PRIVATIZE hook_bool_tree_false
#define LANG_HOOKS_OMP_ARRAY_SIZE lhd_omp_array_size
#define LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR hook_bool_const_tree_false
#define LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT hook_tree_tree_bool_null
@@ -305,7 +306,8 @@ extern tree lhd_unit_size_without_reusable_padding (tree);
LANG_HOOKS_POST_COMPILATION_PARSING_CLEANUPS, \
LANG_HOOKS_DECL_OK_FOR_SIBCALL, \
LANG_HOOKS_OMP_ARRAY_DATA, \
- LANG_HOOKS_OMP_ARRAY_SIZE, \
+ LANG_HOOKS_OMP_ARRAY_DATA_PRIVATIZE, \
+ LANG_HOOKS_OMP_ARRAY_SIZE, \
LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR, \
LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT, \
LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE, \
diff --git a/gcc/langhooks.h b/gcc/langhooks.h
index 6eb5c1602f8..aa983165ab5 100644
--- a/gcc/langhooks.h
+++ b/gcc/langhooks.h
@@ -243,6 +243,10 @@ struct lang_hooks_for_decls
is true, only the TREE_TYPE is returned without generating a new tree. */
tree (*omp_array_data) (tree, bool);
+ /* Return true if the data of an array descriptor is to be copied and
+ privatized. Assumes omp_array_data returns non-NULL_TREE. */
+ bool (*omp_array_data_privatize) (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 second argument
is true, only the TREE_TYPE is returned without generating a new tree. */
diff --git a/gcc/omp-low.cc b/gcc/omp-low.cc
index b93012107f1..79228b6350a 100644
--- a/gcc/omp-low.cc
+++ b/gcc/omp-low.cc
@@ -1443,7 +1443,8 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FIRSTPRIVATE
&& is_gimple_omp_offloaded (ctx->stmt)
&& !is_gimple_omp_oacc (ctx->stmt)
- && lang_hooks.decls.omp_array_data (decl, true))
+ && lang_hooks.decls.omp_array_data (decl, true)
+ && lang_hooks.decls.omp_array_data_privatize (decl))
{
install_var_field (decl, false, 16 | 3, ctx);
install_var_field (decl, true, 8 | 3, ctx);
@@ -13046,7 +13047,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p,
omp_context *ctx)
}
/* Fortran array descriptors: firstprivate of data + attach. */
if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_HAS_DEVICE_ADDR
- && lang_hooks.decls.omp_array_data (var, true))
+ && lang_hooks.decls.omp_array_data (var, true)
+ && lang_hooks.decls.omp_array_data_privatize (var))
map_cnt += 2;
do_dtor:
@@ -13725,7 +13727,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p,
omp_context *ctx)
build_int_cstu (tkind_type, tkind));
/* Fortran array descriptors: firstprivate of data + attach. */
if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_HAS_DEVICE_ADDR
- && lang_hooks.decls.omp_array_data (ovar, true))
+ && lang_hooks.decls.omp_array_data (ovar, true)
+ && lang_hooks.decls.omp_array_data_privatize (ovar))
{
tree not_null_lb, null_lb, after_lb;
tree var1, var2, size1, size2;
diff --git a/libgomp/testsuite/libgomp.fortran/pr122910.f90
b/libgomp/testsuite/libgomp.fortran/pr122910.f90
new file mode 100644
index 00000000000..6081dfa4ea9
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/pr122910.f90
@@ -0,0 +1,23 @@
+! { dg-do run { target { ! offload_device } } }
+
+program main
+ implicit none
+
+ !$omp requires self_maps
+
+ integer :: i
+ INTEGER, POINTER :: fptr(:)
+ integer, parameter :: N = 5
+
+ ALLOCATE(fptr(N))
+ fptr = 0
+
+ !$omp target firstprivate(fptr)
+ DO i=1, N
+ fptr(i) = 5*i
+ END DO
+ !$omp end target
+
+ if (any (fptr /= 5*[1,2,3,4,5])) stop 1
+
+end program
