* [gomp4] add support for derived types in ACC UPDATE
@ 2016-11-10 17:38 Cesar Philippidis
2017-01-30 10:08 ` Thomas Schwinge
0 siblings, 1 reply; 3+ messages in thread
From: Cesar Philippidis @ 2016-11-10 17:38 UTC (permalink / raw)
To: gcc-patches, Fortran List
[-- Attachment #1: Type: text/plain, Size: 772 bytes --]
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
[-- Attachment #2: gomp4-update-dt.diff --]
[-- Type: text/x-patch, Size: 21594 bytes --]
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
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: [gomp4] add support for derived types in ACC UPDATE
2016-11-10 17:38 [gomp4] add support for derived types in ACC UPDATE Cesar Philippidis
@ 2017-01-30 10:08 ` Thomas Schwinge
2017-02-01 17:47 ` Cesar Philippidis
0 siblings, 1 reply; 3+ messages in thread
From: Thomas Schwinge @ 2017-01-30 10:08 UTC (permalink / raw)
To: Cesar Philippidis; +Cc: gcc-patches, Fortran List
Hi Cesar!
On Thu, 10 Nov 2016 09:38:33 -0800, Cesar Philippidis <cesar@codesourcery.com> wrote:
> This patch has been committed to gomp-4_0-branch.
> --- a/gcc/fortran/openmp.c
> +++ b/gcc/fortran/openmp.c
> @@ -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);
[...]/source-gcc/gcc/fortran/openmp.c: In function 'match {+gfc_match_omp_variable_list(const char*, gfc_omp_namelist**, bool, bool*, gfc_omp_namelist***, bool, bool)':+}
[...]/source-gcc/gcc/fortran/openmp.c:246:23: warning: suggest parentheses around '&&' within '||' [-Wparentheses]
if (allow_sections && gfc_peek_ascii_char () == '('
^
> --- 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;
[...]/source-gcc/gcc/fortran/trans-openmp.c: In function 'tree_node* gfc_trans_omp_clauses_1(stmtblock_t*, gfc_omp_clauses*, locus, bool)':
[...]/source-gcc/gcc/fortran/trans-openmp.c:1947:10: warning: unused variable 'orig_decl' [-Wunused-variable]
tree orig_decl = decl;
^
> --- /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.
I guess that "DEVICE" comment here is a leftover? (Doesn't apply to a
compile test.)
> +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)
> +[...]
> --- /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.
Why? Shouldn "!$acc update device" just be a no-op for host execution?
Grüße
Thomas
> +! { 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
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: [gomp4] add support for derived types in ACC UPDATE
2017-01-30 10:08 ` Thomas Schwinge
@ 2017-02-01 17:47 ` Cesar Philippidis
0 siblings, 0 replies; 3+ messages in thread
From: Cesar Philippidis @ 2017-02-01 17:47 UTC (permalink / raw)
To: Thomas Schwinge; +Cc: gcc-patches, Fortran List
[-- Attachment #1: Type: text/plain, Size: 3587 bytes --]
On 01/30/2017 02:08 AM, Thomas Schwinge wrote:
> Hi Cesar!
>
> On Thu, 10 Nov 2016 09:38:33 -0800, Cesar Philippidis <cesar@codesourcery.com> wrote:
>> This patch has been committed to gomp-4_0-branch.
>
>> --- a/gcc/fortran/openmp.c
>> +++ b/gcc/fortran/openmp.c
>
>> @@ -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);
>
> [...]/source-gcc/gcc/fortran/openmp.c: In function 'match {+gfc_match_omp_variable_list(const char*, gfc_omp_namelist**, bool, bool*, gfc_omp_namelist***, bool, bool)':+}
> [...]/source-gcc/gcc/fortran/openmp.c:246:23: warning: suggest parentheses around '&&' within '||' [-Wparentheses]
> if (allow_sections && gfc_peek_ascii_char () == '('
> ^
>
>> --- 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;
>
> [...]/source-gcc/gcc/fortran/trans-openmp.c: In function 'tree_node* gfc_trans_omp_clauses_1(stmtblock_t*, gfc_omp_clauses*, locus, bool)':
> [...]/source-gcc/gcc/fortran/trans-openmp.c:1947:10: warning: unused variable 'orig_decl' [-Wunused-variable]
> tree orig_decl = decl;
> ^
Not sure why this wasn't caught with a bootstrap build. Anyway, I've the
attached patch to gomp4 to fix this issue. It also corrects a problem
that you found with checking enabled.
>> --- /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.
>
> I guess that "DEVICE" comment here is a leftover? (Doesn't apply to a
> compile test.)
>
>> +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)
>> +[...]
>
>> --- /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.
>
> Why? Shouldn "!$acc update device" just be a no-op for host execution?
Just more test coverage.
Cesar
[-- Attachment #2: gomp4-update-fallout.diff --]
[-- Type: text/x-patch, Size: 1998 bytes --]
2017-02-01 Cesar Philippidis <cesar@codesourcery.com>
gcc/fortran/
* openmp.c (gfc_match_omp_variable_list): Eliminate a warning when
checking for derived types.
* trans-openmp.c (gfc_trans_omp_clauses_1): Don't cast derived type
pointers to void pointers.
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 2782a8d..b3506d4 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -243,8 +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 () == '('
- || allow_derived && 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);
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 7826e1c..80aa421 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -1986,9 +1986,10 @@ gfc_trans_omp_clauses_1 (stmtblock_t *block, gfc_omp_clauses *clauses,
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));
+ ptr = gfc_create_var (pvoid_type_node, NULL);
+ scratch = fold_convert (pvoid_type_node,
+ build_fold_addr_expr (scratch));
+ gfc_add_modify (block, ptr, scratch);
OMP_CLAUSE_SIZE (node) = TYPE_SIZE_UNIT (type);
OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
}
@@ -2111,6 +2112,7 @@ gfc_trans_omp_clauses_1 (stmtblock_t *block, gfc_omp_clauses *clauses,
tree t = gfc_create_var (build_pointer_type
(void_type_node),
NULL);
+ ptr = fold_convert (pvoid_type_node, ptr);
gfc_add_modify (block, t, ptr);
ptr = t;
type = TREE_TYPE (type);
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2017-02-01 17:47 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2016-11-10 17:38 [gomp4] add support for derived types in ACC UPDATE Cesar Philippidis
2017-01-30 10:08 ` Thomas Schwinge
2017-02-01 17:47 ` Cesar Philippidis
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).