2016-11-10 Cesar Philippidis <cesar@codesourcery.com>
gcc/fortran/
* openmp.c (gfc_match_omp_variable_list): New allow_derived argument.
(gfc_match_omp_map_clause): Update call to
gfc_match_omp_variable_list.
(gfc_match_omp_clauses): Update calls to gfc_match_omp_map_clause.
(gfc_match_oacc_update): Update call to gfc_match_omp_clauses.
(resolve_omp_clauses): Permit derived type variables in ACC UPDATE
clauses.
* trans-openmp.c (gfc_trans_omp_clauses_1): Lower derived type
members.
gcc/
* gimplify.c (gimplify_scan_omp_clauses): Update handling of ACC
UPDATE variables.
gcc/testsuite/
* gfortran.dg/goacc/derived-types.f90: New test.
libgomp/
* testsuite/libgomp.oacc-fortran/update-2.f90: New test.
@@ -216,7 +216,8 @@ static match
gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
bool allow_common, bool *end_colon = NULL,
gfc_omp_namelist ***headp = NULL,
- bool allow_sections = false)
+ bool allow_sections = false,
+ bool allow_derived = false)
{
gfc_omp_namelist *head, *tail, *p;
locus old_loc, cur_loc;
@@ -242,7 +243,8 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
case MATCH_YES:
gfc_expr *expr;
expr = NULL;
- if (allow_sections && gfc_peek_ascii_char () == '(')
+ if (allow_sections && gfc_peek_ascii_char () == '('
+ || allow_derived && gfc_peek_ascii_char () == '%')
{
gfc_current_locus = cur_loc;
m = gfc_match_variable (&expr, 0);
@@ -634,10 +636,11 @@ cleanup:
static bool
gfc_match_omp_map_clause (gfc_omp_namelist **list, gfc_omp_map_op map_op,
- bool common_blocks)
+ bool common_blocks, bool allow_derived)
{
gfc_omp_namelist **head = NULL;
- if (gfc_match_omp_variable_list ("", list, common_blocks, NULL, &head, true)
+ if (gfc_match_omp_variable_list ("", list, common_blocks, NULL, &head, true,
+ allow_derived)
== MATCH_YES)
{
gfc_omp_namelist *n;
@@ -655,7 +658,8 @@ gfc_match_omp_map_clause (gfc_omp_namelist **list, gfc_omp_map_op map_op,
static match
gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
uint64_t dtype_mask, bool first = true,
- bool needs_space = true, bool openacc = false)
+ bool needs_space = true, bool openacc = false,
+ bool allow_derived = false)
{
gfc_omp_clauses *base_clauses, *c = gfc_get_omp_clauses ();
locus old_loc;
@@ -773,7 +777,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
if ((mask & OMP_CLAUSE_COPY)
&& gfc_match ("copy ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_FORCE_TOFROM, openacc))
+ OMP_MAP_FORCE_TOFROM, openacc,
+ allow_derived))
continue;
if (mask & OMP_CLAUSE_COPYIN)
{
@@ -781,7 +786,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
{
if (gfc_match ("copyin ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_FORCE_TO, true))
+ OMP_MAP_FORCE_TO, true,
+ allow_derived))
continue;
}
else if (gfc_match_omp_variable_list ("copyin (",
@@ -792,7 +798,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
if ((mask & OMP_CLAUSE_COPYOUT)
&& gfc_match ("copyout ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_FORCE_FROM, true))
+ OMP_MAP_FORCE_FROM, true,
+ allow_derived))
continue;
if ((mask & OMP_CLAUSE_COPYPRIVATE)
&& gfc_match_omp_variable_list ("copyprivate (",
@@ -802,14 +809,15 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
if ((mask & OMP_CLAUSE_CREATE)
&& gfc_match ("create ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_FORCE_ALLOC, true))
+ OMP_MAP_FORCE_ALLOC, true,
+ allow_derived))
continue;
break;
case 'd':
if ((mask & OMP_CLAUSE_DELETE)
&& gfc_match ("delete ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_DELETE, true))
+ OMP_MAP_DELETE, true, allow_derived))
continue;
if ((mask & OMP_CLAUSE_DEFAULT)
&& c->default_sharing == OMP_DEFAULT_UNKNOWN)
@@ -862,12 +870,14 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
if ((mask & OMP_CLAUSE_OACC_DEVICE)
&& gfc_match ("device ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_FORCE_TO, false))
+ OMP_MAP_FORCE_TO, false,
+ allow_derived))
continue;
if ((mask & OMP_CLAUSE_DEVICEPTR)
&& gfc_match ("deviceptr ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_FORCE_DEVICEPTR, false))
+ OMP_MAP_FORCE_DEVICEPTR, false,
+ allow_derived))
continue;
if ((mask & OMP_CLAUSE_DEVICE_RESIDENT)
&& gfc_match_omp_variable_list
@@ -991,7 +1001,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
&& gfc_match ("host ( ") == MATCH_YES /* "self" is a synonym for
"host". */
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_FORCE_FROM, true))
+ OMP_MAP_FORCE_FROM, true,
+ allow_derived))
continue;
break;
case 'i':
@@ -1136,47 +1147,48 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
if ((mask & OMP_CLAUSE_PRESENT_OR_COPY)
&& gfc_match ("pcopy ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_TOFROM, true))
+ OMP_MAP_TOFROM, true, allow_derived))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
&& gfc_match ("pcopyin ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_TO, true))
+ OMP_MAP_TO, true, allow_derived))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
&& gfc_match ("pcopyout ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_FROM, true))
+ OMP_MAP_FROM, true, allow_derived))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE)
&& gfc_match ("pcreate ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_ALLOC, true))
+ OMP_MAP_ALLOC, true, allow_derived))
continue;
if ((mask & OMP_CLAUSE_PRESENT)
&& gfc_match ("present ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_FORCE_PRESENT, false))
+ OMP_MAP_FORCE_PRESENT, false,
+ allow_derived))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPY)
&& gfc_match ("present_or_copy ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_TOFROM, true))
+ OMP_MAP_TOFROM, true, allow_derived))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN)
&& gfc_match ("present_or_copyin ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_TO, true))
+ OMP_MAP_TO, true, allow_derived))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT)
&& gfc_match ("present_or_copyout ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_FROM, true))
+ OMP_MAP_FROM, true, allow_derived))
continue;
if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE)
&& gfc_match ("present_or_create ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_ALLOC, true))
+ OMP_MAP_ALLOC, true, allow_derived))
continue;
if ((mask & OMP_CLAUSE_PRIVATE)
&& gfc_match_omp_variable_list ("private (",
@@ -1356,7 +1368,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
if ((mask & OMP_CLAUSE_HOST)
&& gfc_match ("self ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_FORCE_FROM, true))
+ OMP_MAP_FORCE_FROM, true,
+ allow_derived))
continue;
if ((mask & OMP_CLAUSE_SEQ)
&& !c->seq
@@ -1758,7 +1771,7 @@ gfc_match_oacc_update (void)
if (gfc_match_omp_clauses (&c, OACC_UPDATE_CLAUSES,
OACC_UPDATE_CLAUSE_DEVICE_TYPE_MASK, false,
- false, true)
+ false, true, true)
!= MATCH_YES)
return MATCH_ERROR;
@@ -3739,9 +3752,12 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
|| n->expr->ref == NULL
|| n->expr->ref->next
|| n->expr->ref->type != REF_ARRAY)
- gfc_error ("%qs in %s clause at %L is not a proper "
- "array section", n->sym->name, name,
- &n->where);
+ {
+ if (n->sym->ts.type != BT_DERIVED)
+ gfc_error ("%qs in %s clause at %L is not a proper "
+ "array section", n->sym->name, name,
+ &n->where);
+ }
else if (n->expr->ref->u.ar.codimen)
gfc_error ("Coarrays not supported in %s clause at %L",
name, &n->where);
@@ -1938,7 +1938,66 @@ gfc_trans_omp_clauses_1 (stmtblock_t *block, gfc_omp_clauses *clauses,
tree decl = gfc_get_symbol_decl (n->sym);
if (DECL_P (decl))
TREE_ADDRESSABLE (decl) = 1;
- if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
+ /* Handle derived-typed members for OpenACC Update. */
+ if (n->sym->ts.type == BT_DERIVED
+ && n->expr != NULL && n->expr->ref != NULL
+ && (n->expr->ref->next == NULL
+ || (n->expr->ref->next != NULL
+ && n->expr->ref->next->type == REF_ARRAY
+ && n->expr->ref->next->u.ar.type == AR_FULL)))
+ {
+ gfc_ref *ref = n->expr->ref;
+ tree orig_decl = decl;
+ gfc_component *c = ref->u.c.component;
+ tree field;
+ tree context;
+ tree ptr;
+ tree type;
+ tree scratch;
+
+ if (c->backend_decl == NULL_TREE
+ && ref->u.c.sym != NULL)
+ gfc_get_derived_type (ref->u.c.sym);
+
+ field = c->backend_decl;
+ gcc_assert (field && TREE_CODE (field) == FIELD_DECL);
+ context = DECL_FIELD_CONTEXT (field);
+
+ type = TREE_TYPE (decl);
+ if (POINTER_TYPE_P (type))
+ type = TREE_TYPE (type);
+
+ if (context != type)
+ {
+ tree f2 = c->norestrict_decl;
+ if (!f2 || DECL_FIELD_CONTEXT (f2) != type)
+ for (f2 = TYPE_FIELDS (TREE_TYPE (decl)); f2;
+ f2 = DECL_CHAIN (f2))
+ if (TREE_CODE (f2) == FIELD_DECL
+ && DECL_NAME (f2) == DECL_NAME (field))
+ break;
+ gcc_assert (f2);
+ c->norestrict_decl = f2;
+ field = f2;
+ }
+
+ if (POINTER_TYPE_P (TREE_TYPE (decl)))
+ decl = build_fold_indirect_ref_loc (input_location,
+ decl);
+
+ scratch = fold_build3_loc (input_location, COMPONENT_REF,
+ TREE_TYPE (field), decl, field,
+ NULL_TREE);
+ type = TREE_TYPE (scratch);
+ ptr = gfc_create_var (build_pointer_type (void_type_node),
+ NULL);
+ gfc_add_modify (block, ptr, build_fold_addr_expr (scratch));
+ OMP_CLAUSE_SIZE (node) = TYPE_SIZE_UNIT (type);
+ OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
+ }
+ else if ((n->sym->ts.type == BT_DERIVED && n->expr == NULL)
+ || (n->expr == NULL
+ || n->expr->ref->u.ar.type == AR_FULL))
{
if (POINTER_TYPE_P (TREE_TYPE (decl))
&& (gfc_omp_privatize_by_reference (decl)
@@ -2038,13 +2097,26 @@ gfc_trans_omp_clauses_1 (stmtblock_t *block, gfc_omp_clauses *clauses,
{
tree ptr, ptr2;
gfc_init_se (&se, NULL);
- if (n->expr->ref->u.ar.type == AR_ELEMENT)
+ if ((n->sym->ts.type == BT_DERIVED
+ && n->expr->rank == 0)
+ || (n->sym->ts.type != BT_DERIVED
+ && n->expr->ref->u.ar.type == AR_ELEMENT))
{
gfc_conv_expr_reference (&se, n->expr);
gfc_add_block_to_block (block, &se.pre);
ptr = se.expr;
+ tree type = TREE_TYPE (ptr);
+ if (n->sym->ts.type == BT_DERIVED)
+ {
+ tree t = gfc_create_var (build_pointer_type
+ (void_type_node),
+ NULL);
+ gfc_add_modify (block, t, ptr);
+ ptr = t;
+ type = TREE_TYPE (type);
+ }
OMP_CLAUSE_SIZE (node)
- = TYPE_SIZE_UNIT (TREE_TYPE (ptr));
+ = TYPE_SIZE_UNIT (type);
}
else
{
@@ -2065,6 +2137,8 @@ gfc_trans_omp_clauses_1 (stmtblock_t *block, gfc_omp_clauses *clauses,
gfc_add_block_to_block (block, &se.post);
OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
+ if (n->sym->ts.type == BT_DERIVED)
+ goto finalize_map_clause;
if (POINTER_TYPE_P (TREE_TYPE (decl))
&& GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (decl))))
{
@@ -2108,6 +2182,7 @@ gfc_trans_omp_clauses_1 (stmtblock_t *block, gfc_omp_clauses *clauses,
ptr2 = fold_convert (sizetype, ptr2);
OMP_CLAUSE_SIZE (node3)
= fold_build2 (MINUS_EXPR, sizetype, ptr, ptr2);
+ finalize_map_clause:;
}
switch (n->u.map_op)
{
@@ -7049,7 +7049,8 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
= splay_tree_lookup (ctx->variables, (splay_tree_key)decl);
bool ptr = (OMP_CLAUSE_MAP_KIND (c)
== GOMP_MAP_ALWAYS_POINTER);
- if (n == NULL || (n->value & GOVD_MAP) == 0)
+ if ((n == NULL || (n->value & GOVD_MAP) == 0)
+ && code != OACC_UPDATE)
{
tree l = build_omp_clause (OMP_CLAUSE_LOCATION (c),
OMP_CLAUSE_MAP);
new file mode 100644
@@ -0,0 +1,78 @@
+! Test ACC UPDATE with derived types. The DEVICE clause depends on an
+! accelerator being present.
+
+module dt
+ integer, parameter :: n = 10
+ type inner
+ integer :: d(n)
+ end type inner
+ type dtype
+ integer(8) :: a, b, c(n)
+ type(inner) :: in
+ end type dtype
+end module dt
+
+program derived_acc
+ use dt
+
+ implicit none
+ type(dtype):: var
+ integer i
+ !$acc declare create(var)
+ !$acc declare pcopy(var%a) ! { dg-error "Syntax error in OpenMP" }
+
+ !$acc update host(var)
+ !$acc update host(var%a)
+ !$acc update device(var)
+ !$acc update device(var%a)
+ !$acc update self(var)
+ !$acc update self(var%a)
+
+ !$acc enter data copyin(var)
+ !$acc enter data copyin(var%a) ! { dg-error "Syntax error in OpenMP" }
+
+ !$acc exit data copyout(var)
+ !$acc exit data copyout(var%a) ! { dg-error "Syntax error in OpenMP" }
+
+ !$acc data copy(var)
+ !$acc end data
+
+ !$acc data copyout(var%a) ! { dg-error "Syntax error in OpenMP" }
+ !$acc end data ! { dg-error "Unexpected ..ACC END" }
+
+ !$acc parallel loop pcopyout(var)
+ do i = 1, 10
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop copyout(var%a) ! { dg-error "Syntax error in OpenMP" }
+ do i = 1, 10
+ end do
+ !$acc end parallel loop ! { dg-error "Unexpected ..ACC END" }
+
+ !$acc parallel pcopy(var)
+ !$acc end parallel
+
+ !$acc parallel pcopy(var%a) ! { dg-error "Syntax error in OpenMP" }
+ do i = 1, 10
+ end do
+ !$acc end parallel ! { dg-error "Unexpected ..ACC END" }
+
+ !$acc kernels pcopyin(var)
+ !$acc end kernels
+
+ !$acc kernels pcopy(var%a) ! { dg-error "Syntax error in OpenMP" }
+ do i = 1, 10
+ end do
+ !$acc end kernels ! { dg-error "Unexpected ..ACC END" }
+
+ !$acc kernels loop pcopyin(var)
+ do i = 1, 10
+ end do
+ !$acc end kernels loop
+
+ !$acc kernels loop pcopy(var%a) ! { dg-error "Syntax error in OpenMP" }
+ do i = 1, 10
+ end do
+ !$acc end kernels loop ! { dg-error "Unexpected ..ACC END" }
+end program derived_acc
new file mode 100644
@@ -0,0 +1,285 @@
+! Test ACC UPDATE with derived types. The DEVICE clause depends on an
+! accelerator being present.
+
+! { dg-do run { target openacc_nvidia_accel_selected } }
+
+module dt
+ integer, parameter :: n = 10
+ type inner
+ integer :: d(n)
+ end type inner
+ type mytype
+ integer(8) :: a, b, c(n)
+ type(inner) :: in
+ end type mytype
+end module dt
+
+program derived_acc
+ use dt
+
+ implicit none
+ integer i, res
+ type(mytype) :: var
+
+ var%a = 0
+ var%b = 1
+ var%c(:) = 10
+ var%in%d(:) = 100
+
+ var%c(:) = 10
+
+ !$acc enter data copyin(var)
+
+ !$acc parallel loop present(var)
+ do i = 1, 1
+ var%a = var%b
+ end do
+ !$acc end parallel loop
+
+ !$acc update host(var%a)
+
+ if (var%a /= var%b) call abort
+
+ var%b = 100
+
+ !$acc update device(var%b)
+
+ !$acc parallel loop present(var)
+ do i = 1, 1
+ var%a = var%b
+ end do
+ !$acc end parallel loop
+
+ !$acc update host(var%a)
+
+ if (var%a /= var%b) call abort
+
+ !$acc parallel loop present (var)
+ do i = 1, n
+ var%c(i) = i
+ end do
+ !$acc end parallel loop
+
+ !$acc update host(var%c)
+
+ var%a = -1
+
+ do i = 1, n
+ if (var%c(i) /= i) call abort
+ var%c(i) = var%a
+ end do
+
+ !$acc update device(var%a)
+ !$acc update device(var%c)
+
+ res = 0
+
+ !$acc parallel loop present(var) reduction(+:res)
+ do i = 1, n
+ if (var%c(i) /= var%a) res = res + 1
+ end do
+
+ if (res /= 0) call abort
+
+ var%c(:) = 0
+
+ !$acc update device(var%c)
+
+ !$acc parallel loop present(var)
+ do i = 5, 5
+ var%c(i) = 1
+ end do
+ !$acc end parallel loop
+
+ !$acc update host(var%c(5))
+
+ do i = 1, n
+ if (i /= 5 .and. var%c(i) /= 0) call abort
+ if (i == 5 .and. var%c(i) /= 1) call abort
+ end do
+
+ !$acc parallel loop present(var)
+ do i = 1, n
+ var%in%d = var%a
+ end do
+ !$acc end parallel loop
+
+ !$acc update host(var%in%d)
+
+ do i = 1, n
+ if (var%in%d(i) /= var%a) call abort
+ end do
+
+ var%c(:) = 0
+
+ !$acc update device(var%c)
+
+ var%c(:) = -1
+
+ !$acc parallel loop present(var)
+ do i = n/2, n
+ var%c(i) = i
+ end do
+ !$acc end parallel loop
+
+ !$acc update host(var%c(n/2:n))
+
+ do i = 1,n
+ if (i < n/2 .and. var%c(i) /= -1) call abort
+ if (i >= n/2 .and. var%c(i) /= i) call abort
+ end do
+
+ var%in%d(:) = 0
+ !$acc update device(var%in%d)
+
+ !$acc parallel loop present(var)
+ do i = 5, 5
+ var%in%d(i) = 1
+ end do
+ !$acc end parallel loop
+
+ !$acc update host(var%in%d(5))
+
+ do i = 1, n
+ if (i /= 5 .and. var%in%d(i) /= 0) call abort
+ if (i == 5 .and. var%in%d(i) /= 1) call abort
+ end do
+
+ !$acc exit data delete(var)
+
+ call derived_acc_subroutine(var)
+end program derived_acc
+
+subroutine derived_acc_subroutine(var)
+ use dt
+
+ implicit none
+ integer i, res
+ type(mytype) :: var
+
+ var%a = 0
+ var%b = 1
+ var%c(:) = 10
+ var%in%d(:) = 100
+
+ var%c(:) = 10
+
+ !$acc enter data copyin(var)
+
+ !$acc parallel loop present(var)
+ do i = 1, 1
+ var%a = var%b
+ end do
+ !$acc end parallel loop
+
+ !$acc update host(var%a)
+
+ if (var%a /= var%b) call abort
+
+ var%b = 100
+
+ !$acc update device(var%b)
+
+ !$acc parallel loop present(var)
+ do i = 1, 1
+ var%a = var%b
+ end do
+ !$acc end parallel loop
+
+ !$acc update host(var%a)
+
+ if (var%a /= var%b) call abort
+
+ !$acc parallel loop present (var)
+ do i = 1, n
+ var%c(i) = i
+ end do
+ !$acc end parallel loop
+
+ !$acc update host(var%c)
+
+ var%a = -1
+
+ do i = 1, n
+ if (var%c(i) /= i) call abort
+ var%c(i) = var%a
+ end do
+
+ !$acc update device(var%a)
+ !$acc update device(var%c)
+
+ res = 0
+
+ !$acc parallel loop present(var) reduction(+:res)
+ do i = 1, n
+ if (var%c(i) /= var%a) res = res + 1
+ end do
+
+ if (res /= 0) call abort
+
+ var%c(:) = 0
+
+ !$acc update device(var%c)
+
+ !$acc parallel loop present(var)
+ do i = 5, 5
+ var%c(i) = 1
+ end do
+ !$acc end parallel loop
+
+ !$acc update host(var%c(5))
+
+ do i = 1, n
+ if (i /= 5 .and. var%c(i) /= 0) call abort
+ if (i == 5 .and. var%c(i) /= 1) call abort
+ end do
+
+ !$acc parallel loop present(var)
+ do i = 1, n
+ var%in%d = var%a
+ end do
+ !$acc end parallel loop
+
+ !$acc update host(var%in%d)
+
+ do i = 1, n
+ if (var%in%d(i) /= var%a) call abort
+ end do
+
+ var%c(:) = 0
+
+ !$acc update device(var%c)
+
+ var%c(:) = -1
+
+ !$acc parallel loop present(var)
+ do i = n/2, n
+ var%c(i) = i
+ end do
+ !$acc end parallel loop
+
+ !$acc update host(var%c(n/2:n))
+
+ do i = 1,n
+ if (i < n/2 .and. var%c(i) /= -1) call abort
+ if (i >= n/2 .and. var%c(i) /= i) call abort
+ end do
+
+ var%in%d(:) = 0
+ !$acc update device(var%in%d)
+
+ !$acc parallel loop present(var)
+ do i = 5, 5
+ var%in%d(i) = 1
+ end do
+ !$acc end parallel loop
+
+ !$acc update host(var%in%d(5))
+
+ do i = 1, n
+ if (i /= 5 .and. var%in%d(i) /= 0) call abort
+ if (i == 5 .and. var%in%d(i) /= 1) call abort
+ end do
+
+ !$acc exit data delete(var)
+end subroutine derived_acc_subroutine