This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[gomp4] add support for derived types in ACC UPDATE
- From: Cesar Philippidis <cesar at codesourcery dot com>
- To: "gcc-patches at gcc dot gnu dot org" <gcc-patches at gcc dot gnu dot org>, Fortran List <fortran at gcc dot gnu dot org>
- Date: Thu, 10 Nov 2016 09:38:33 -0800
- Subject: [gomp4] add support for derived types in ACC UPDATE
- Authentication-results: sourceware.org; auth=none
OpenACC 2.0a has limited support for fortran derived types. Basically,
derived type variables are only supported in ACC UPDATE. Rather than
adding generalized support for derived times in the gimplifier, this
patch has the fortran FE pass both subarrays and arrays as void pointers
with an appropriate OMP_CLAUSE_SIZE. ACC UPDATE is an executable
directive, and the gimplifier would just end up pruning out all of the
unnecessary supporting data clauses otherwise.
As of right now, GCC still lacks support for non-contiguous subarray
arguments to ACC UPDATE. I'm not sure why it was decided to let ACC
UPDATE support non-contiguous subarrays, but it already is an oddball
with its lone support for derived types.
This patch has been committed to gomp-4_0-branch.
Cesar
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.
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 95885bc..0a9d137 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -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);
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index f374451..9924872 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -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)
{
diff --git a/gcc/gimplify.c b/gcc/gimplify.c
index 2c25a2e..36c128b 100644
--- a/gcc/gimplify.c
+++ b/gcc/gimplify.c
@@ -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);
diff --git a/gcc/testsuite/gfortran.dg/goacc/derived-types.f90 b/gcc/testsuite/gfortran.dg/goacc/derived-types.f90
new file mode 100644
index 0000000..7f1a821
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/derived-types.f90
@@ -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
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/update-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/update-2.f90
new file mode 100644
index 0000000..769ef6b
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/update-2.f90
@@ -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