https://gcc.gnu.org/bugzilla/show_bug.cgi?id=100991
Bug ID: 100991
Summary: [OpenMP] firstprivate for optional arguments is
mishandled
Product: gcc
Version: 12.0
Status: UNCONFIRMED
Keywords: openmp
Severity: normal
Priority: P3
Component: fortran
Assignee: unassigned at gcc dot gnu.org
Reporter: burnus at gcc dot gnu.org
Target Milestone: ---
Split off from my defaultmap patch.
FAILING is either:
(A) FIRST TEST:
libgomp/testsuite/libgomp.fortran/optional-map.f90
for the implicitly mapped
subroutine sub2(ii, ...
integer, optional :: ii, ...
but that requires the trans-openmp.c patch shown below (otherwise, ii is mapped
fromto)
(B) SECOND TEST
program main
implicit none
integer :: ii
ii = 7
call foo(ii)
call foo()
contains
subroutine foo (ii1)
integer, optional :: ii1
!$omp target firstprivate(ii1)
if (present (ii1)) then
if (ii1 /= 7) stop 1
ii1 = 5
end if
!$omp end target
if (present (ii1)) then
if (ii1 /= 7) stop 1
end if
end
end
Patch mentioned for (A):
gfc_omp_scalar_p (tree decl, bool ptr_alloc_ok)
{
tree type = TREE_TYPE (decl);
+ if (gfc_omp_is_optional_argument (decl))
+ type = TREE_TYPE (type);
if (TREE_CODE (type) == REFERENCE_TYPE)
type = TREE_TYPE (type);
if (TREE_CODE (type) == POINTER_TYPE)
* * * *
The code needed is similar to:
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -12804,7 +12804,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p,
omp_context *ctx)
if (omp_is_reference (ovar))
type = TREE_TYPE (type);
if ((INTEGRAL_TYPE_P (type)
- && TYPE_PRECISION (type) <= POINTER_SIZE)
+ && TYPE_PRECISION (type) <= POINTER_SIZE
+ && !omp_check_optional_argument (ovar, false))
|| TREE_CODE (type) == POINTER_TYPE)
{
tkind = GOMP_MAP_FIRSTPRIVATE_INT;
@@ -13026,13 +13027,15 @@ lower_omp_target (gimple_stmt_iterator *gsi_p,
omp_context *ctx)
|| is_gimple_reg_type (TREE_TYPE (var)))
{
tree new_var = lookup_decl (var, ctx);
+ bool is_optional = omp_check_optional_argument (var, false);
tree type;
type = TREE_TYPE (var);
if (omp_is_reference (var))
type = TREE_TYPE (type);
if ((INTEGRAL_TYPE_P (type)
&& TYPE_PRECISION (type) <= POINTER_SIZE)
- || TREE_CODE (type) == POINTER_TYPE)
+ || TREE_CODE (type) == POINTER_TYPE
+ || is_optional)
{
x = build_receiver_ref (var, false, ctx);
if (TREE_CODE (type) != POINTER_TYPE)
@@ -13040,11 +13043,14 @@ lower_omp_target (gimple_stmt_iterator *gsi_p,
omp_context *ctx)
x = fold_convert (type, x);
gimplify_expr (&x, &new_body, NULL, is_gimple_val,
fb_rvalue);
- if (omp_is_reference (var))
+ if (omp_is_reference (var) || is_optional)
{
+ tree present = (is_optional
+ ? omp_check_optional_argument (ovar,
true)
+ : NULL_TREE);
...
(Cf. other code in this file.)
Except, of course, that this does not handle all the fun stuff which is not
trivially assignable. (allocatable arrays, polymorphic ...)
