/* 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). */
+ assumed-shape variables (decl is a local variable containing arg->data).
+ Note that pvoid_type_node is for 'type(c_ptr), value. */
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
+ && !VOID_TYPE_P (TREE_TYPE (TREE_TYPE (decl)))
&& GFC_DECL_OPTIONAL_ARGUMENT (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)
+ /* Scalars with VALUE attribute which are passed by value use a hidden
+ argument to denote the present status. They are passed as nonpointer 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];
tree tree_name;
case OMP_CLAUSE_USE_DEVICE_PTR:
case OMP_CLAUSE_USE_DEVICE_ADDR:
case OMP_CLAUSE_IS_DEVICE_PTR:
- bool do_optional_check;
- do_optional_check = false;
ovar = OMP_CLAUSE_DECL (c);
var = lookup_decl_in_outer_ctx (ovar, ctx);
}
type = TREE_TYPE (ovar);
if (lang_hooks.decls.omp_array_data (ovar, true))
- {
- var = lang_hooks.decls.omp_array_data (ovar, false);
- do_optional_check = true;
- }
+ var = lang_hooks.decls.omp_array_data (ovar, false);
else if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR
&& !omp_is_reference (ovar)
&& !omp_is_allocatable_or_ptr (ovar))
&& !omp_is_allocatable_or_ptr (ovar))
|| (omp_is_reference (ovar)
&& omp_is_allocatable_or_ptr (ovar))))
- {
- var = build_simple_mem_ref (var);
- do_optional_check = true;
- }
+ var = build_simple_mem_ref (var);
var = fold_convert (TREE_TYPE (x), var);
}
}
tree present;
- present = (do_optional_check
- ? omp_check_optional_argument (ovar, true) : NULL_TREE);
+ present = omp_check_optional_argument (ovar, true);
if (present)
{
tree null_label = create_artificial_label (UNKNOWN_LOCATION);
! Check whether absent optional arguments are properly
! handled with use_device_{addr,ptr}.
program main
+ use iso_c_binding, only: c_ptr, c_loc, c_associated
implicit none (type, external)
call foo()
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 :: w
integer, target, optional :: x(:)
integer, target, optional, allocatable :: y
integer, target, optional, allocatable :: z(:)
+ type(c_ptr), target, optional, value :: cptr
+ type(c_ptr), target, optional, value, intent(in) :: cptr_in
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
+ ! Need to map per-VALUE arguments, if present
+ if (present(v)) then
+ !$omp target enter data map(to:v)
+ stop 1 ! – but it shall not be present in this test case.
+ end if
+ 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
! 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 target data map(d) use_device_ptr(w, x, y, z, cptr, cptr_in)
+ if (present(w)) then; w = 5; stop 21; endif
+ if (present(x)) then; x(1) = 5; stop 22; endif
+ if (present(y)) then; y = 5; stop 23; endif
+ 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
end subroutine foo
end program main