Commit c3cb71ef by Tobias Burnus Committed by Tobias Burnus

OpenMP] Fix use_device_… with absent optional arg

        gcc/fortran/
        * trans-openmp.c (gfc_omp_is_optional_argument,
        gfc_omp_check_optional_argument): Handle type(c_ptr),value which uses a
        hidden argument for the is-present check.

        gcc/
        * omp-low.c (lower_omp_target): For use_device_ptr/use_derice_addr
        and Fortran's optional arguments, unconditionally add the is-present
        condition before the libgomp call.

        libgomp/
        * testsuite/libgomp.fortran/use_device_ptr-optional-2.f90: Add
        'type(c_ptr), value' test case. Conditionally map the per-value
        passed arguments.

From-SVN: r279004
parent 705f02b0
2019-12-05 Tobias Burnus <tobias@codesourcery.com>
* omp-low.c (lower_omp_target): For use_device_ptr/use_derice_addr
and Fortran's optional arguments, unconditionally add the is-present
condition before the libgomp call.
2019-12-05 Richard Sandiford <richard.sandiford@arm.com> 2019-12-05 Richard Sandiford <richard.sandiford@arm.com>
PR middle-end/92768 PR middle-end/92768
2019-12-05 Tobias Burnus <tobias@codesourcery.com>
* trans-openmp.c (gfc_omp_is_optional_argument,
gfc_omp_check_optional_argument): Handle type(c_ptr),value which uses a
2019-12-05 Jakub Jelinek <jakub@redhat.com> 2019-12-05 Jakub Jelinek <jakub@redhat.com>
PR fortran/92781 PR fortran/92781
......
...@@ -60,7 +60,8 @@ gfc_omp_is_allocatable_or_ptr (const_tree decl) ...@@ -60,7 +60,8 @@ gfc_omp_is_allocatable_or_ptr (const_tree decl)
/* True if the argument is an optional argument; except that false is also /* True if the argument is an optional argument; except that false is also
returned for arguments with the value attribute (nonpointers) and for returned for arguments with the value attribute (nonpointers) and for
assumed-shape variables (decl is a local variable containing arg->data). */ assumed-shape variables (decl is a local variable containing arg->data).
Note that pvoid_type_node is for 'type(c_ptr), value. */
static bool static bool
gfc_omp_is_optional_argument (const_tree decl) gfc_omp_is_optional_argument (const_tree decl)
...@@ -68,6 +69,7 @@ gfc_omp_is_optional_argument (const_tree decl) ...@@ -68,6 +69,7 @@ gfc_omp_is_optional_argument (const_tree decl)
return (TREE_CODE (decl) == PARM_DECL return (TREE_CODE (decl) == PARM_DECL
&& DECL_LANG_SPECIFIC (decl) && DECL_LANG_SPECIFIC (decl)
&& TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE
&& !VOID_TYPE_P (TREE_TYPE (TREE_TYPE (decl)))
&& GFC_DECL_OPTIONAL_ARGUMENT (decl)); && GFC_DECL_OPTIONAL_ARGUMENT (decl));
} }
...@@ -99,9 +101,12 @@ gfc_omp_check_optional_argument (tree decl, bool for_present_check) ...@@ -99,9 +101,12 @@ gfc_omp_check_optional_argument (tree decl, bool for_present_check)
|| !GFC_DECL_OPTIONAL_ARGUMENT (decl)) || !GFC_DECL_OPTIONAL_ARGUMENT (decl))
return NULL_TREE; return NULL_TREE;
/* For VALUE, the scalar variable is passed as is but a hidden argument /* Scalars with VALUE attribute which are passed by value use a hidden
denotes the value. Cf. trans-expr.c. */ argument to denote the present status. They are passed as nonpointer type
if (TREE_CODE (TREE_TYPE (decl)) != POINTER_TYPE) with one exception: 'type(c_ptr), value' as 'void*'. */
/* Cf. trans-expr.c's gfc_conv_expr_present. */
if (TREE_CODE (TREE_TYPE (decl)) != POINTER_TYPE
|| VOID_TYPE_P (TREE_TYPE (TREE_TYPE (decl))))
{ {
char name[GFC_MAX_SYMBOL_LEN + 2]; char name[GFC_MAX_SYMBOL_LEN + 2];
tree tree_name; tree tree_name;
......
...@@ -11981,8 +11981,6 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) ...@@ -11981,8 +11981,6 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
case OMP_CLAUSE_USE_DEVICE_PTR: case OMP_CLAUSE_USE_DEVICE_PTR:
case OMP_CLAUSE_USE_DEVICE_ADDR: case OMP_CLAUSE_USE_DEVICE_ADDR:
case OMP_CLAUSE_IS_DEVICE_PTR: case OMP_CLAUSE_IS_DEVICE_PTR:
bool do_optional_check;
do_optional_check = false;
ovar = OMP_CLAUSE_DECL (c); ovar = OMP_CLAUSE_DECL (c);
var = lookup_decl_in_outer_ctx (ovar, ctx); var = lookup_decl_in_outer_ctx (ovar, ctx);
...@@ -12004,10 +12002,7 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) ...@@ -12004,10 +12002,7 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
} }
type = TREE_TYPE (ovar); type = TREE_TYPE (ovar);
if (lang_hooks.decls.omp_array_data (ovar, true)) 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 else if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR
&& !omp_is_reference (ovar) && !omp_is_reference (ovar)
&& !omp_is_allocatable_or_ptr (ovar)) && !omp_is_allocatable_or_ptr (ovar))
...@@ -12025,16 +12020,12 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) ...@@ -12025,16 +12020,12 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
&& !omp_is_allocatable_or_ptr (ovar)) && !omp_is_allocatable_or_ptr (ovar))
|| (omp_is_reference (ovar) || (omp_is_reference (ovar)
&& omp_is_allocatable_or_ptr (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); var = fold_convert (TREE_TYPE (x), var);
} }
} }
tree present; tree present;
present = (do_optional_check present = omp_check_optional_argument (ovar, true);
? omp_check_optional_argument (ovar, true) : NULL_TREE);
if (present) if (present)
{ {
tree null_label = create_artificial_label (UNKNOWN_LOCATION); tree null_label = create_artificial_label (UNKNOWN_LOCATION);
......
2019-12-05 Tobias Burnus <tobias@codesourcery.com>
* testsuite/libgomp.fortran/use_device_ptr-optional-2.f90: Add
'type(c_ptr), value' test case. Conditionally map the per-value
passed arguments.
2019-12-05 Richard Sandiford <richard.sandiford@arm.com> 2019-12-05 Richard Sandiford <richard.sandiford@arm.com>
PR middle-end/92768 PR middle-end/92768
......
! Check whether absent optional arguments are properly ! Check whether absent optional arguments are properly
! handled with use_device_{addr,ptr}. ! handled with use_device_{addr,ptr}.
program main program main
use iso_c_binding, only: c_ptr, c_loc, c_associated
implicit none (type, external) implicit none (type, external)
call foo() call foo()
contains contains
subroutine foo(v, w, x, y, z) subroutine foo(v, w, x, y, z, cptr, cptr_in)
integer, target, optional, value :: v integer, target, optional, value :: v
integer, target, optional :: w integer, target, optional :: w
integer, target, optional :: x(:) integer, target, optional :: x(:)
integer, target, optional, allocatable :: y integer, target, optional, allocatable :: y
integer, target, optional, allocatable :: z(:) integer, target, optional, allocatable :: z(:)
type(c_ptr), target, optional, value :: cptr
type(c_ptr), target, optional, value, intent(in) :: cptr_in
integer :: d integer :: d
!$omp target data map(d) use_device_addr(v, w, x, y, z) ! Need to map per-VALUE arguments, if present
if(present(v)) stop 1 if (present(v)) then
if(present(w)) stop 2 !$omp target enter data map(to:v)
if(present(x)) stop 3 stop 1 ! – but it shall not be present in this test case.
if(present(y)) stop 4 end if
if(present(z)) stop 5 if (present(cptr)) then
!$omp target enter data map(to:cptr)
stop 2 ! – but it shall not be present in this test case.
end if
if (present(cptr_in)) then
!$omp target enter data map(to:cptr_in)
stop 3 ! – but it shall not be present in this test case.
end if
!$omp target data map(d) use_device_addr(v, w, x, y, z, cptr, cptr_in)
if (present(v)) then; v = 5; stop 11; endif
if (present(w)) then; w = 5; stop 12; endif
if (present(x)) then; x(1) = 5; stop 13; endif
if (present(y)) then; y = 5; stop 14; endif
if (present(z)) then; z(1) = 5; stop 15; endif
if (present(cptr)) then; cptr = c_loc(v); stop 16; endif
if (present(cptr_in)) then
if (c_associated(cptr_in, c_loc(x))) stop 26
stop 27
endif
!$omp end target data !$omp end target data
! Using 'v' in use_device_ptr gives an ICE ! Using 'v' in use_device_ptr gives an ICE
! TODO: Find out what the OpenMP spec permits for use_device_ptr ! TODO: Find out what the OpenMP spec permits for use_device_ptr
!$omp target data map(d) use_device_ptr(w, x, y, z) !$omp target data map(d) use_device_ptr(w, x, y, z, cptr, cptr_in)
if(present(w)) stop 6 if (present(w)) then; w = 5; stop 21; endif
if(present(x)) stop 7 if (present(x)) then; x(1) = 5; stop 22; endif
if(present(y)) stop 8 if (present(y)) then; y = 5; stop 23; endif
if(present(z)) stop 9 if (present(z)) then; z(1) = 5; stop 24; endif
if (present(cptr)) then; cptr = c_loc(x); stop 25; endif
if (present(cptr_in)) then
if (c_associated(cptr_in, c_loc(x))) stop 26
stop 27
endif
!$omp end target data !$omp end target data
end subroutine foo end subroutine foo
end program main end program main
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment