* [PATCH, OpenACC] Support Fortran derived type members in "acc update" directives
@ 2018-09-04 0:47 Julian Brown
2018-12-04 14:17 ` Jakub Jelinek
0 siblings, 1 reply; 5+ messages in thread
From: Julian Brown @ 2018-09-04 0:47 UTC (permalink / raw)
To: gcc-patches, Cesar Philippidis, Jakub Jelinek
[-- Attachment #1: Type: text/plain, Size: 1249 bytes --]
Hi,
This patch (by Cesar) adds support for Fortran derived type members in
"acc update" directives (as specified in OpenACC 2.5 2.14.4., Update
Directive). Seemingly only "update" directives may specify derived type
members in this way as of OpenACC 2.5.
Tested with offloading to NVPTX and bootstrapped.
OK to apply?
Thanks,
Julian
2018-09-03 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.
* testsuite/libgomp.oacc-fortran/derived-type-1.f90: New test.
[-- Attachment #2: derived-types-acc-update-2.diff --]
[-- Type: text/x-patch, Size: 22380 bytes --]
commit a7e1f0958d38bfda7474fbaf6bb31951351ab66d
Author: Julian Brown <julian@codesourcery.com>
Date: Thu Aug 30 17:00:58 2018 -0700
Derived types for acc update.
2018-09-03 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.
* testsuite/libgomp.oacc-fortran/derived-type-1.f90: New test.
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 94a7f7e..80a4c05 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -222,7 +222,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;
@@ -248,7 +249,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);
@@ -914,10 +916,12 @@ omp_inv_mask::omp_inv_mask (const omp_mask &m) : omp_mask (m)
mapping. */
static bool
-gfc_match_omp_map_clause (gfc_omp_namelist **list, gfc_omp_map_op map_op)
+gfc_match_omp_map_clause (gfc_omp_namelist **list, gfc_omp_map_op map_op,
+ bool allow_derived)
{
gfc_omp_namelist **head = NULL;
- if (gfc_match_omp_variable_list ("", list, false, NULL, &head, true)
+ if (gfc_match_omp_variable_list ("", list, false, NULL, &head, true,
+ allow_derived)
== MATCH_YES)
{
gfc_omp_namelist *n;
@@ -935,7 +939,7 @@ 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, const omp_mask mask,
bool first = true, bool needs_space = true,
- bool openacc = false)
+ bool openacc = false, bool allow_derived = false)
{
gfc_omp_clauses *c = gfc_get_omp_clauses ();
locus old_loc;
@@ -1039,7 +1043,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
if ((mask & OMP_CLAUSE_COPY)
&& gfc_match ("copy ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_TOFROM))
+ OMP_MAP_TOFROM, allow_derived))
continue;
if (mask & OMP_CLAUSE_COPYIN)
{
@@ -1047,7 +1051,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
{
if (gfc_match ("copyin ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_TO))
+ OMP_MAP_TO, allow_derived))
continue;
}
else if (gfc_match_omp_variable_list ("copyin (",
@@ -1058,7 +1062,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
if ((mask & OMP_CLAUSE_COPYOUT)
&& gfc_match ("copyout ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_FROM))
+ OMP_MAP_FROM, allow_derived))
continue;
if ((mask & OMP_CLAUSE_COPYPRIVATE)
&& gfc_match_omp_variable_list ("copyprivate (",
@@ -1068,7 +1072,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
if ((mask & OMP_CLAUSE_CREATE)
&& gfc_match ("create ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_ALLOC))
+ OMP_MAP_ALLOC, allow_derived))
continue;
break;
case 'd':
@@ -1104,7 +1108,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
if ((mask & OMP_CLAUSE_DELETE)
&& gfc_match ("delete ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_RELEASE))
+ OMP_MAP_RELEASE, allow_derived))
continue;
if ((mask & OMP_CLAUSE_DEPEND)
&& gfc_match ("depend ( ") == MATCH_YES)
@@ -1156,12 +1160,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
&& openacc
&& gfc_match ("device ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_FORCE_TO))
+ OMP_MAP_FORCE_TO, 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))
+ OMP_MAP_FORCE_DEVICEPTR,
+ allow_derived))
continue;
if ((mask & OMP_CLAUSE_DEVICE_RESIDENT)
&& gfc_match_omp_variable_list
@@ -1239,7 +1244,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
if ((mask & OMP_CLAUSE_HOST_SELF)
&& gfc_match ("host ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_FORCE_FROM))
+ OMP_MAP_FORCE_FROM, allow_derived))
continue;
break;
case 'i':
@@ -1511,47 +1516,48 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
if ((mask & OMP_CLAUSE_COPY)
&& gfc_match ("pcopy ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_TOFROM))
+ OMP_MAP_TOFROM, allow_derived))
continue;
if ((mask & OMP_CLAUSE_COPYIN)
&& gfc_match ("pcopyin ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_TO))
+ OMP_MAP_TO, allow_derived))
continue;
if ((mask & OMP_CLAUSE_COPYOUT)
&& gfc_match ("pcopyout ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_FROM))
+ OMP_MAP_FROM, allow_derived))
continue;
if ((mask & OMP_CLAUSE_CREATE)
&& gfc_match ("pcreate ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_ALLOC))
+ OMP_MAP_ALLOC, 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))
+ OMP_MAP_FORCE_PRESENT,
+ allow_derived))
continue;
if ((mask & OMP_CLAUSE_COPY)
&& gfc_match ("present_or_copy ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_TOFROM))
+ OMP_MAP_TOFROM, allow_derived))
continue;
if ((mask & OMP_CLAUSE_COPYIN)
&& gfc_match ("present_or_copyin ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_TO))
+ OMP_MAP_TO, allow_derived))
continue;
if ((mask & OMP_CLAUSE_COPYOUT)
&& gfc_match ("present_or_copyout ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_FROM))
+ OMP_MAP_FROM, allow_derived))
continue;
if ((mask & OMP_CLAUSE_CREATE)
&& gfc_match ("present_or_create ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_ALLOC))
+ OMP_MAP_ALLOC, allow_derived))
continue;
if ((mask & OMP_CLAUSE_PRIORITY)
&& c->priority == NULL
@@ -1774,7 +1780,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
if ((mask & OMP_CLAUSE_HOST_SELF)
&& gfc_match ("self ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
- OMP_MAP_FORCE_FROM))
+ OMP_MAP_FORCE_FROM, allow_derived))
continue;
if ((mask & OMP_CLAUSE_SEQ)
&& !c->seq
@@ -2130,7 +2136,7 @@ gfc_match_oacc_update (void)
gfc_omp_clauses *c;
locus here = gfc_current_locus;
- if (gfc_match_omp_clauses (&c, OACC_UPDATE_CLAUSES, false, false, true)
+ if (gfc_match_omp_clauses (&c, OACC_UPDATE_CLAUSES, false, false, true, true)
!= MATCH_YES)
return MATCH_ERROR;
@@ -4336,9 +4342,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 f038f4c..95b15e5 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -2108,7 +2108,68 @@ gfc_trans_omp_clauses (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))
+ && (n->expr->ref->type == REF_ARRAY
+ && n->expr->ref->u.ar.type != AR_SECTION))
+ {
+ gfc_ref *ref = n->expr->ref;
+ 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 (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);
+ }
+ 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)
@@ -2210,13 +2271,27 @@ gfc_trans_omp_clauses (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);
+ ptr = fold_convert (pvoid_type_node, ptr);
+ 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
{
@@ -2239,6 +2314,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
ptr);
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))))
{
@@ -2282,6 +2359,7 @@ gfc_trans_omp_clauses (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 dbd0f0e..f7f7f52 100644
--- a/gcc/gimplify.c
+++ b/gcc/gimplify.c
@@ -7955,7 +7955,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..44a3814
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/derived-types.f90
@@ -0,0 +1,77 @@
+! Test ACC UPDATE with derived types.
+
+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/derived-type-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/derived-type-1.f90
new file mode 100644
index 0000000..1ec4784
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/derived-type-1.f90
@@ -0,0 +1,28 @@
+! Test derived types with subarrays
+
+! { dg-do run }
+
+ implicit none
+ type dtype
+ integer :: a, b, c
+ end type dtype
+ integer, parameter :: n = 100
+ integer i
+ type (dtype), dimension(n) :: d
+
+ !$acc data copy(d(1:n))
+ !$acc parallel loop
+ do i = 1, n
+ d(i)%a = i
+ d(i)%b = i-1
+ d(i)%c = i+1
+ end do
+ !$acc end data
+
+ do i = 1, n
+ if (d(i)%a /= i) call abort
+ if (d(i)%b /= i-1) call abort
+ if (d(i)%c /= i+1) call abort
+ end do
+end program
+
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..a37d526
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/update-2.f90
@@ -0,0 +1,284 @@
+! Test ACC UPDATE with derived types.
+
+! { dg-do run }
+
+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] 5+ messages in thread
* Re: [PATCH, OpenACC] Support Fortran derived type members in "acc update" directives
2018-09-04 0:47 [PATCH, OpenACC] Support Fortran derived type members in "acc update" directives Julian Brown
@ 2018-12-04 14:17 ` Jakub Jelinek
2018-12-04 19:06 ` Julian Brown
0 siblings, 1 reply; 5+ messages in thread
From: Jakub Jelinek @ 2018-12-04 14:17 UTC (permalink / raw)
To: Julian Brown; +Cc: gcc-patches, Cesar Philippidis
On Mon, Sep 03, 2018 at 08:46:54PM -0400, Julian Brown wrote:
> 2018-09-03 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.
> * testsuite/libgomp.oacc-fortran/derived-type-1.f90: New test.
Note, already OpenMP 4.5 allows the %s in map/to/from clauses, I just didn't
get to that yet.
And OpenMP 5.0 allows arbitrary expressions there.
> @@ -4336,9 +4342,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);
I'm worried about this change a little bit. It isn't guarded for OpenACC
only and I wonder if you actually resolve properly the derived expressions
(look inside of those).
> diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
> index f038f4c..95b15e5 100644
> --- a/gcc/fortran/trans-openmp.c
> +++ b/gcc/fortran/trans-openmp.c
> @@ -2108,7 +2108,68 @@ gfc_trans_omp_clauses (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))
> + && (n->expr->ref->type == REF_ARRAY
> + && n->expr->ref->u.ar.type != AR_SECTION))
Like here you have all kinds of conditions, but has resolving made sure all
the needed diagnostics is emitted?
Perhaps at least for now this also should be guarded on OpenACC only,
once OpenMP allows %s in map/to/from, part of this will be usable for it,
but e.g.
> + 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;
> + }
the above stuff looks way too OpenACC specific.
Jakub
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: [PATCH, OpenACC] Support Fortran derived type members in "acc update" directives
2018-12-04 14:17 ` Jakub Jelinek
@ 2018-12-04 19:06 ` Julian Brown
2018-12-04 19:13 ` Jakub Jelinek
0 siblings, 1 reply; 5+ messages in thread
From: Julian Brown @ 2018-12-04 19:06 UTC (permalink / raw)
To: Jakub Jelinek; +Cc: gcc-patches, Cesar Philippidis
Hi Jakub,
On Tue, 4 Dec 2018 15:17:08 +0100
Jakub Jelinek <jakub@redhat.com> wrote:
> On Mon, Sep 03, 2018 at 08:46:54PM -0400, Julian Brown wrote:
> > 2018-09-03 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.
> > * testsuite/libgomp.oacc-fortran/derived-type-1.f90: New
> > test.
>
> Note, already OpenMP 4.5 allows the %s in map/to/from clauses, I just
> didn't get to that yet.
> And OpenMP 5.0 allows arbitrary expressions there.
>
> > @@ -4336,9 +4342,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);
>
> I'm worried about this change a little bit. It isn't guarded for
> OpenACC only and I wonder if you actually resolve properly the
> derived expressions (look inside of those).
>
> > diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
> > index f038f4c..95b15e5 100644
> > --- a/gcc/fortran/trans-openmp.c
> > +++ b/gcc/fortran/trans-openmp.c
> > @@ -2108,7 +2108,68 @@ gfc_trans_omp_clauses (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))
> > + && (n->expr->ref->type == REF_ARRAY
> > + && n->expr->ref->u.ar.type != AR_SECTION))
>
> Like here you have all kinds of conditions, but has resolving made
> sure all the needed diagnostics is emitted?
> Perhaps at least for now this also should be guarded on OpenACC only,
> once OpenMP allows %s in map/to/from, part of this will be usable for
> it, but e.g.
>
> > + 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;
> > + }
>
> the above stuff looks way too OpenACC specific.
Thanks for the review! As it happened though, I had to rewrite a lot of
the code in this patch for the attach/detach patch, and I had meant to
withdraw this one. Many apologies about the wasted time! I mentioned
the superseding in the first submission of the attach/detach patch:
https://gcc.gnu.org/ml/gcc-patches/2018-11/msg00826.html
but omitted to follow up with a link back from this patch to that one.
A revised version of the attach/detach patch is here:
https://gcc.gnu.org/ml/gcc-patches/2018-11/msg02556.html
OpenACC 2.6 allows derived type member accesses (or structs, etc.) on
more types of directive than just "update", so this patch wasn't
sufficient -- for the new code replacing the bits in this patch (i.e.
the bits under gcc/fortran), I tried to integrate with the existing
code a little better, hopefully without disturbing the OpenMP side too
much.
I transferred the new tests from this patch over to the attach/detach
patch also, where of course they pass.
Cheers,
Julian
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: [PATCH, OpenACC] Support Fortran derived type members in "acc update" directives
2018-12-04 19:06 ` Julian Brown
@ 2018-12-04 19:13 ` Jakub Jelinek
2018-12-04 19:20 ` Julian Brown
0 siblings, 1 reply; 5+ messages in thread
From: Jakub Jelinek @ 2018-12-04 19:13 UTC (permalink / raw)
To: Julian Brown; +Cc: gcc-patches, Cesar Philippidis
On Tue, Dec 04, 2018 at 07:06:43PM +0000, Julian Brown wrote:
> Thanks for the review! As it happened though, I had to rewrite a lot of
> the code in this patch for the attach/detach patch, and I had meant to
> withdraw this one. Many apologies about the wasted time! I mentioned
> the superseding in the first submission of the attach/detach patch:
>
> https://gcc.gnu.org/ml/gcc-patches/2018-11/msg00826.html
I haven't looked at the dynamic array series because I haven't heard
back on https://gcc.gnu.org/ml/gcc-patches/2018-10/msg00946.html
Jakub
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: [PATCH, OpenACC] Support Fortran derived type members in "acc update" directives
2018-12-04 19:13 ` Jakub Jelinek
@ 2018-12-04 19:20 ` Julian Brown
0 siblings, 0 replies; 5+ messages in thread
From: Julian Brown @ 2018-12-04 19:20 UTC (permalink / raw)
To: Jakub Jelinek; +Cc: gcc-patches, Cesar Philippidis
On Tue, 4 Dec 2018 20:12:58 +0100
Jakub Jelinek <jakub@redhat.com> wrote:
> On Tue, Dec 04, 2018 at 07:06:43PM +0000, Julian Brown wrote:
> > Thanks for the review! As it happened though, I had to rewrite a
> > lot of the code in this patch for the attach/detach patch, and I
> > had meant to withdraw this one. Many apologies about the wasted
> > time! I mentioned the superseding in the first submission of the
> > attach/detach patch:
> >
> > https://gcc.gnu.org/ml/gcc-patches/2018-11/msg00826.html
>
> I haven't looked at the dynamic array series because I haven't heard
> back on https://gcc.gnu.org/ml/gcc-patches/2018-10/msg00946.html
Those patches are independent of the attach/detach ones (though the
latter do depend on Chung-Lin's async support patches).
Thanks,
Julian
^ permalink raw reply [flat|nested] 5+ messages in thread
end of thread, other threads:[~2018-12-04 19:20 UTC | newest]
Thread overview: 5+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2018-09-04 0:47 [PATCH, OpenACC] Support Fortran derived type members in "acc update" directives Julian Brown
2018-12-04 14:17 ` Jakub Jelinek
2018-12-04 19:06 ` Julian Brown
2018-12-04 19:13 ` Jakub Jelinek
2018-12-04 19:20 ` Julian Brown
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).