From: Julian Brown <julian@codesourcery.com>
To: <gcc-patches@gcc.gnu.org>
Cc: <fortran@gcc.gnu.org>, Tobias Burnus <tobias@codesourcery.com>
Subject: [PATCH 6/7] [og10] openacc: Fix lowering for derived-type mappings through array elements
Date: Wed, 24 Feb 2021 13:58:37 -0800 [thread overview]
Message-ID: <20210224215838.130807-2-julian@codesourcery.com> (raw)
In-Reply-To: <20210224215838.130807-1-julian@codesourcery.com>
This patch fixes lowering of derived-type mappings which select elements
of arrays of derived types, and similar. These would previously lead
to ICEs.
With this change, OpenACC directives can pass through constructs that
are no longer recognized by the gimplifier, hence alterations are needed
there also.
gcc/fortran/
* trans-openmp.c (gfc_trans_omp_clauses): Handle element selection
for arrays of derived types.
gcc/
* gimplify.c (gimplify_scan_omp_clauses): Handle ATTACH_DETACH
for non-decls.
gcc/testsuite/
* gfortran.dg/goacc/array-with-dt-1.f90: New test.
* gfortran.dg/goacc/array-with-dt-3.f90: Likewise.
* gfortran.dg/goacc/array-with-dt-4.f90: Likewise.
* gfortran.dg/goacc/array-with-dt-5.f90: Likewise.
* gfortran.dg/goacc/derived-chartypes-1.f90: Re-enable test.
* gfortran.dg/goacc/derived-chartypes-2.f90: Likewise.
* gfortran.dg/goacc/derived-classtypes-1.f95: Uncomment
previously-broken directives.
libgomp/
* testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90: New test.
* testsuite/libgomp.oacc-fortran/update-dt-array.f90: Likewise.
(cherry picked from commit d28f3da11d8c0aed9b746689d723022a9b5ec04c)
---
gcc/ChangeLog.omp | 7 +
gcc/fortran/ChangeLog.omp | 7 +
gcc/fortran/trans-openmp.c | 192 ++++++++++--------
gcc/gimplify.c | 12 ++
gcc/testsuite/ChangeLog.omp | 13 ++
.../gfortran.dg/goacc/array-with-dt-1.f90 | 11 +
.../gfortran.dg/goacc/array-with-dt-3.f90 | 14 ++
.../gfortran.dg/goacc/array-with-dt-4.f90 | 18 ++
.../gfortran.dg/goacc/array-with-dt-5.f90 | 12 ++
.../gfortran.dg/goacc/derived-chartypes-1.f90 | 3 -
.../gfortran.dg/goacc/derived-chartypes-2.f90 | 3 -
.../goacc/derived-classtypes-1.f95 | 8 +-
libgomp/ChangeLog.omp | 7 +
.../derivedtypes-arrays-1.f90 | 109 ++++++++++
.../libgomp.oacc-fortran/update-dt-array.f90 | 53 +++++
15 files changed, 378 insertions(+), 91 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/goacc/array-with-dt-1.f90
create mode 100644 gcc/testsuite/gfortran.dg/goacc/array-with-dt-3.f90
create mode 100644 gcc/testsuite/gfortran.dg/goacc/array-with-dt-4.f90
create mode 100644 gcc/testsuite/gfortran.dg/goacc/array-with-dt-5.f90
create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90
create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/update-dt-array.f90
diff --git a/gcc/ChangeLog.omp b/gcc/ChangeLog.omp
index ba959fb37a4f..a59c25b79763 100644
--- a/gcc/ChangeLog.omp
+++ b/gcc/ChangeLog.omp
@@ -1,3 +1,10 @@
+2021-02-24 Julian Brown <julian@codesourcery.com>
+
+ Backport from mainline
+
+ * gimplify.c (gimplify_scan_omp_clauses): Handle ATTACH_DETACH
+ for non-decls.
+
2021-02-16 Tobias Burnus <tobias@codesourcery.com>
* doc/invoke.texi (nvptx's -misa): Update default to sm_35.
diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index f99a11316f52..007855075563 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,10 @@
+2021-02-24 Julian Brown <julian@codesourcery.com>
+
+ Backport from mainline
+
+ * trans-openmp.c (gfc_trans_omp_clauses): Handle element selection
+ for arrays of derived types.
+
2021-02-24 Tobias Burnus <tobias@codesourcery.com>
Backport from mainline
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index d0e299b02142..e3df4bbf84ec 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -2660,6 +2660,32 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
tree decl = gfc_trans_omp_variable (n->sym, false);
if (DECL_P (decl))
TREE_ADDRESSABLE (decl) = 1;
+
+ gfc_ref *lastref = NULL;
+
+ if (n->expr)
+ for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
+ if (ref->type == REF_COMPONENT || ref->type == REF_ARRAY)
+ lastref = ref;
+
+ bool allocatable = false, pointer = false;
+
+ if (lastref && lastref->type == REF_COMPONENT)
+ {
+ gfc_component *c = lastref->u.c.component;
+
+ if (c->ts.type == BT_CLASS)
+ {
+ pointer = CLASS_DATA (c)->attr.class_pointer;
+ allocatable = CLASS_DATA (c)->attr.allocatable;
+ }
+ else
+ {
+ pointer = c->attr.pointer;
+ allocatable = c->attr.allocatable;
+ }
+ }
+
if (n->expr == NULL
|| (n->expr->ref->type == REF_ARRAY
&& n->expr->ref->u.ar.type == AR_FULL))
@@ -2887,74 +2913,79 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
}
else if (n->expr
&& n->expr->expr_type == EXPR_VARIABLE
- && n->expr->ref->type == REF_COMPONENT)
+ && n->expr->ref->type == REF_ARRAY
+ && !n->expr->ref->next)
{
- gfc_ref *lastcomp;
-
- for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
- if (ref->type == REF_COMPONENT)
- lastcomp = ref;
-
- symbol_attribute sym_attr;
-
- if (lastcomp->u.c.component->ts.type == BT_CLASS)
- sym_attr = CLASS_DATA (lastcomp->u.c.component)->attr;
- else
- sym_attr = lastcomp->u.c.component->attr;
-
+ /* An array element or array section which is not part of a
+ derived type, etc. */
+ bool element = n->expr->ref->u.ar.type == AR_ELEMENT;
+ gfc_trans_omp_array_section (block, n, decl, element,
+ GOMP_MAP_POINTER, node, node2,
+ node3, node4);
+ }
+ else if (n->expr
+ && n->expr->expr_type == EXPR_VARIABLE
+ && (n->expr->ref->type == REF_COMPONENT
+ || n->expr->ref->type == REF_ARRAY)
+ && lastref
+ && lastref->type == REF_COMPONENT
+ && lastref->u.c.component->ts.type != BT_CLASS
+ && lastref->u.c.component->ts.type != BT_DERIVED
+ && !lastref->u.c.component->attr.dimension)
+ {
+ /* Derived type access with last component being a scalar. */
gfc_init_se (&se, NULL);
- if (!sym_attr.dimension
- && lastcomp->u.c.component->ts.type != BT_CLASS
- && lastcomp->u.c.component->ts.type != BT_DERIVED)
+ gfc_conv_expr (&se, n->expr);
+ gfc_add_block_to_block (block, &se.pre);
+ /* For BT_CHARACTER a pointer is returned. */
+ OMP_CLAUSE_DECL (node)
+ = POINTER_TYPE_P (TREE_TYPE (se.expr))
+ ? build_fold_indirect_ref (se.expr) : se.expr;
+ gfc_add_block_to_block (block, &se.post);
+ if (pointer || allocatable)
{
- /* Last component is a scalar. */
- gfc_conv_expr (&se, n->expr);
- gfc_add_block_to_block (block, &se.pre);
- /* For BT_CHARACTER a pointer is returned. */
- OMP_CLAUSE_DECL (node)
+ node2 = build_omp_clause (input_location,
+ OMP_CLAUSE_MAP);
+ gomp_map_kind kind
+ = (openacc ? GOMP_MAP_ATTACH_DETACH
+ : GOMP_MAP_ALWAYS_POINTER);
+ OMP_CLAUSE_SET_MAP_KIND (node2, kind);
+ OMP_CLAUSE_DECL (node2)
= POINTER_TYPE_P (TREE_TYPE (se.expr))
- ? build_fold_indirect_ref (se.expr) : se.expr;
- gfc_add_block_to_block (block, &se.post);
- if (sym_attr.pointer || sym_attr.allocatable)
+ ? se.expr
+ : gfc_build_addr_expr (NULL, se.expr);
+ OMP_CLAUSE_SIZE (node2) = size_int (0);
+ if (!openacc
+ && n->expr->ts.type == BT_CHARACTER
+ && n->expr->ts.deferred)
{
- node2 = build_omp_clause (input_location,
+ gcc_assert (se.string_length);
+ tree tmp
+ = gfc_get_char_type (n->expr->ts.kind);
+ OMP_CLAUSE_SIZE (node)
+ = fold_build2 (MULT_EXPR, size_type_node,
+ fold_convert (size_type_node,
+ se.string_length),
+ TYPE_SIZE_UNIT (tmp));
+ node3 = build_omp_clause (input_location,
OMP_CLAUSE_MAP);
- OMP_CLAUSE_SET_MAP_KIND (node2,
- openacc
- ? GOMP_MAP_ATTACH_DETACH
- : GOMP_MAP_ALWAYS_POINTER);
- OMP_CLAUSE_DECL (node2)
- = POINTER_TYPE_P (TREE_TYPE (se.expr))
- ? se.expr : gfc_build_addr_expr (NULL, se.expr);
- OMP_CLAUSE_SIZE (node2) = size_int (0);
- if (!openacc
- && n->expr->ts.type == BT_CHARACTER
- && n->expr->ts.deferred)
- {
- gcc_assert (se.string_length);
- tree tmp = gfc_get_char_type (n->expr->ts.kind);
- OMP_CLAUSE_SIZE (node)
- = fold_build2 (MULT_EXPR, size_type_node,
- fold_convert (size_type_node,
- se.string_length),
- TYPE_SIZE_UNIT (tmp));
- node3 = build_omp_clause (input_location,
- OMP_CLAUSE_MAP);
- OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_TO);
- OMP_CLAUSE_DECL (node3) = se.string_length;
- OMP_CLAUSE_SIZE (node3)
- = TYPE_SIZE_UNIT (gfc_charlen_type_node);
- }
+ OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_TO);
+ OMP_CLAUSE_DECL (node3) = se.string_length;
+ OMP_CLAUSE_SIZE (node3)
+ = TYPE_SIZE_UNIT (gfc_charlen_type_node);
}
- goto finalize_map_clause;
}
-
+ }
+ else if (n->expr
+ && n->expr->expr_type == EXPR_VARIABLE
+ && (n->expr->ref->type == REF_COMPONENT
+ || n->expr->ref->type == REF_ARRAY))
+ {
+ gfc_init_se (&se, NULL);
se.expr = gfc_maybe_dereference_var (n->sym, decl);
- for (gfc_ref *ref = n->expr->ref;
- ref && ref != lastcomp->next;
- ref = ref->next)
+ for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
{
if (ref->type == REF_COMPONENT)
{
@@ -2963,24 +2994,30 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
gfc_conv_component_ref (&se, ref);
}
+ else if (ref->type == REF_ARRAY)
+ {
+ if (ref->u.ar.type == AR_ELEMENT && ref->next)
+ gfc_conv_array_ref (&se, &ref->u.ar, n->expr,
+ &n->expr->where);
+ else
+ gcc_assert (!ref->next);
+ }
else
- sorry ("unhandled derived-type component");
+ sorry ("unhandled expression type");
}
tree inner = se.expr;
/* Last component is a derived type or class pointer. */
- if (lastcomp->u.c.component->ts.type == BT_DERIVED
- || lastcomp->u.c.component->ts.type == BT_CLASS)
+ if (lastref->type == REF_COMPONENT
+ && (lastref->u.c.component->ts.type == BT_DERIVED
+ || lastref->u.c.component->ts.type == BT_CLASS))
{
- bool pointer
- = (lastcomp->u.c.component->ts.type == BT_CLASS
- ? sym_attr.class_pointer : sym_attr.pointer);
- if (pointer || (openacc && sym_attr.allocatable))
+ if (pointer || (openacc && allocatable))
{
tree data, size;
- if (lastcomp->u.c.component->ts.type == BT_CLASS)
+ if (lastref->u.c.component->ts.type == BT_CLASS)
{
data = gfc_class_data_get (inner);
gcc_assert (POINTER_TYPE_P (TREE_TYPE (data)));
@@ -3011,9 +3048,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
= TYPE_SIZE_UNIT (TREE_TYPE (inner));
}
}
- else if (lastcomp->next
- && lastcomp->next->type == REF_ARRAY
- && lastcomp->next->u.ar.type == AR_FULL)
+ else if (lastref->type == REF_ARRAY
+ && lastref->u.ar.type == AR_FULL)
{
/* Just pass the (auto-dereferenced) decl through for
bare attach and detach clauses. */
@@ -3107,27 +3143,21 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
else
OMP_CLAUSE_DECL (node) = inner;
}
- else /* An array element or section. */
+ else if (lastref->type == REF_ARRAY)
{
- bool element
- = (lastcomp->next
- && lastcomp->next->type == REF_ARRAY
- && lastcomp->next->u.ar.type == AR_ELEMENT);
-
+ /* An array element or section. */
+ bool element = lastref->u.ar.type == AR_ELEMENT;
gomp_map_kind kind = (openacc ? GOMP_MAP_ATTACH_DETACH
: GOMP_MAP_ALWAYS_POINTER);
gfc_trans_omp_array_section (block, n, inner, element,
kind, node, node2, node3,
node4);
}
+ else
+ gcc_unreachable ();
}
- else /* An array element or array section. */
- {
- bool element = n->expr->ref->u.ar.type == AR_ELEMENT;
- gfc_trans_omp_array_section (block, n, decl, element,
- GOMP_MAP_POINTER, node, node2,
- node3, node4);
- }
+ else
+ sorry ("unhandled expression");
finalize_map_clause:
diff --git a/gcc/gimplify.c b/gcc/gimplify.c
index 4e99ee2d38af..bf2129c79580 100644
--- a/gcc/gimplify.c
+++ b/gcc/gimplify.c
@@ -9440,6 +9440,18 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
}
}
}
+ else if ((code == OACC_ENTER_DATA
+ || code == OACC_EXIT_DATA
+ || code == OACC_DATA
+ || code == OACC_PARALLEL
+ || code == OACC_KERNELS
+ || code == OACC_SERIAL)
+ && OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_ATTACH_DETACH)
+ {
+ gomp_map_kind k = (code == OACC_EXIT_DATA
+ ? GOMP_MAP_DETACH : GOMP_MAP_ATTACH);
+ OMP_CLAUSE_SET_MAP_KIND (c, k);
+ }
if (gimplify_expr (pd, pre_p, NULL, is_gimple_lvalue, fb_lvalue)
== GS_ERROR)
diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index 257981890982..98032a72d4b9 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,16 @@
+2021-02-24 Julian Brown <julian@codesourcery.com>
+
+ Backport from mainline
+
+ * gfortran.dg/goacc/array-with-dt-1.f90: New test.
+ * gfortran.dg/goacc/array-with-dt-3.f90: Likewise.
+ * gfortran.dg/goacc/array-with-dt-4.f90: Likewise.
+ * gfortran.dg/goacc/array-with-dt-5.f90: Likewise.
+ * gfortran.dg/goacc/derived-chartypes-1.f90: Re-enable test.
+ * gfortran.dg/goacc/derived-chartypes-2.f90: Likewise.
+ * gfortran.dg/goacc/derived-classtypes-1.f95: Uncomment
+ previously-broken directives.
+
2021-02-24 Tobias Burnus <tobias@codesourcery.com>
Backport from mainline
diff --git a/gcc/testsuite/gfortran.dg/goacc/array-with-dt-1.f90 b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-1.f90
new file mode 100644
index 000000000000..4a3ff0ef3a75
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-1.f90
@@ -0,0 +1,11 @@
+type t
+ integer, allocatable :: A(:,:)
+end type t
+
+type(t), allocatable :: b(:)
+
+!$acc update host(b)
+!$acc update host(b(:))
+!$acc update host(b(1)%A)
+!$acc update host(b(1)%A(:,:))
+end
diff --git a/gcc/testsuite/gfortran.dg/goacc/array-with-dt-3.f90 b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-3.f90
new file mode 100644
index 000000000000..dcb63657f2bb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-3.f90
@@ -0,0 +1,14 @@
+type t2
+ integer :: A(200,200)
+end type t2
+type t
+ integer, allocatable :: A(:,:)
+end type t
+
+type(t2),allocatable :: c(:)
+type(t), allocatable :: d(:)
+
+!$acc exit data delete(c(1)%A)
+!$acc exit data delete(d(1)%A)
+
+end
diff --git a/gcc/testsuite/gfortran.dg/goacc/array-with-dt-4.f90 b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-4.f90
new file mode 100644
index 000000000000..637d5f57e1c1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-4.f90
@@ -0,0 +1,18 @@
+type t4
+ integer, allocatable :: quux(:)
+end type t4
+type t3
+ type(t4), pointer :: qux(:)
+end type t3
+type t2
+ type(t3), allocatable :: bar(:)
+end type t2
+type t
+ type(t2), allocatable :: foo(:)
+end type t
+
+type(t), allocatable :: c(:)
+
+!$acc enter data copyin(c(5)%foo(4)%bar(3)%qux(2)%quux(:))
+!$acc exit data delete(c(5)%foo(4)%bar(3)%qux(2)%quux(:))
+end
diff --git a/gcc/testsuite/gfortran.dg/goacc/array-with-dt-5.f90 b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-5.f90
new file mode 100644
index 000000000000..900587b7eaf6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-5.f90
@@ -0,0 +1,12 @@
+type t2
+ integer :: bar
+end type t2
+type t
+ type(t2), pointer :: foo
+end type t
+
+type(t) :: c
+
+!$acc enter data copyin(c%foo)
+
+end
diff --git a/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-1.f90 b/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-1.f90
index f7aafbfc036f..e4d360e1262b 100644
--- a/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-1.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-1.f90
@@ -1,6 +1,3 @@
-! This currently ICEs. Avoid that.
-! { dg-skip-if "PR98979" { *-*-* } }
-
type :: type1
character(len=35) :: a
end type type1
diff --git a/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-2.f90 b/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-2.f90
index e22fc679df2b..cca6443e7fcf 100644
--- a/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-2.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-2.f90
@@ -1,6 +1,3 @@
-! This currently ICEs. Avoid that.
-! { dg-skip-if "PR98979" { *-*-* } }
-
type :: type1
character(len=35,kind=4) :: a
end type type1
diff --git a/gcc/testsuite/gfortran.dg/goacc/derived-classtypes-1.f95 b/gcc/testsuite/gfortran.dg/goacc/derived-classtypes-1.f95
index e6cf09c6d3c1..85a2e1d373d0 100644
--- a/gcc/testsuite/gfortran.dg/goacc/derived-classtypes-1.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/derived-classtypes-1.f95
@@ -71,7 +71,7 @@ class(type7), allocatable :: acshiela
!$acc enter data copyin(bar)
!$acc enter data copyin(bar%b)
!$acc enter data copyin(qux)
-!!$acc enter data copyin(qux%c)
+!$acc enter data copyin(qux%c)
!$acc enter data copyin(quux)
!$acc enter data copyin(quux%d)
!$acc enter data copyin(fred)
@@ -86,7 +86,7 @@ class(type7), allocatable :: acshiela
!$acc enter data copyin(pbar)
!$acc enter data copyin(pbar%b)
!$acc enter data copyin(pqux)
-!!$acc enter data copyin(pqux%c)
+!$acc enter data copyin(pqux%c)
!$acc enter data copyin(pquux)
!$acc enter data copyin(pquux%d)
!$acc enter data copyin(pfred)
@@ -101,7 +101,7 @@ class(type7), allocatable :: acshiela
!$acc enter data copyin(cbar)
!$acc enter data copyin(cbar%b)
!$acc enter data copyin(cqux)
-!!$acc enter data copyin(cqux%c)
+!$acc enter data copyin(cqux%c)
!$acc enter data copyin(cquux)
!$acc enter data copyin(cquux%d)
!$acc enter data copyin(cfred)
@@ -116,7 +116,7 @@ class(type7), allocatable :: acshiela
!$acc enter data copyin(acbar)
!$acc enter data copyin(acbar%b)
!$acc enter data copyin(acqux)
-!!$acc enter data copyin(acqux%c)
+!$acc enter data copyin(acqux%c)
!$acc enter data copyin(acquux)
!$acc enter data copyin(acquux%d)
!$acc enter data copyin(acfred)
diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp
index db6ac79fe123..0f862d1b573a 100644
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/ChangeLog.omp
@@ -1,3 +1,10 @@
+2021-02-24 Julian Brown <julian@codesourcery.com>
+
+ Backport from mainline
+
+ * testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90: New test.
+ * testsuite/libgomp.oacc-fortran/update-dt-array.f90: Likewise.
+
2021-02-24 Julian Brown <julian@codesourcery.com>
Backport from mainline
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90
new file mode 100644
index 000000000000..644ad1f6b2fc
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90
@@ -0,0 +1,109 @@
+! { dg-do run }
+
+type type1
+ integer, allocatable :: arr1(:,:)
+end type type1
+
+type type2
+ type(type1) :: t1
+end type type2
+
+type type3
+ type(type2) :: t2(20)
+end type type3
+
+type type4
+ type(type3), allocatable :: t3(:)
+end type type4
+
+integer :: i, j, k
+
+type(type4), allocatable :: var1(:)
+type(type4) :: var2
+type(type3) :: var3
+
+allocate(var1(1:20))
+do i=1,20
+ allocate(var1(i)%t3(1:20))
+ do j=1,20
+ do k=1,20
+ allocate(var1(i)%t3(j)%t2(k)%t1%arr1(1:20,1:20))
+ end do
+ end do
+end do
+
+allocate(var2%t3(1:20))
+do i=1,20
+ do j=1,20
+ allocate(var2%t3(i)%t2(j)%t1%arr1(1:20,1:20))
+ end do
+end do
+
+do i=1,20
+ do j=1,20
+ do k=1,20
+ var1(i)%t3(j)%t2(k)%t1%arr1(:,:) = 0
+ end do
+ var2%t3(i)%t2(j)%t1%arr1(:,:) = 0
+ end do
+end do
+
+!$acc enter data copyin(var2%t3(4)%t2(3)%t1%arr1(:,:))
+!$acc enter data copyin(var1(5)%t3(4)%t2(3)%t1%arr1(:,:))
+
+var2%t3(4)%t2(3)%t1%arr1(:,:) = 5
+var1(5)%t3(4)%t2(3)%t1%arr1(:,:) = 4
+
+!$acc update device(var2%t3(4)%t2(3)%t1%arr1)
+!$acc update device(var1(5)%t3(4)%t2(3)%t1%arr1)
+
+!$acc exit data copyout(var1(5)%t3(4)%t2(3)%t1%arr1(:,:))
+!$acc exit data copyout(var2%t3(4)%t2(3)%t1%arr1(:,:))
+
+do i=1,20
+ do j=1,20
+ do k=1,20
+ if (i.eq.5 .and. j.eq.4 .and. k.eq.3) then
+ if (any(var1(i)%t3(j)%t2(k)%t1%arr1 .ne. 4)) stop 1
+ else
+ if (any(var1(i)%t3(j)%t2(k)%t1%arr1 .ne. 0)) stop 2
+ end if
+ end do
+ if (i.eq.4 .and. j.eq.3) then
+ if (any(var2%t3(i)%t2(j)%t1%arr1 .ne. 5)) stop 3
+ else
+ if (any(var2%t3(i)%t2(j)%t1%arr1 .ne. 0)) stop 4
+ end if
+ end do
+end do
+
+do i=1,20
+ allocate(var3%t2(i)%t1%arr1(1:20, 1:20))
+ var3%t2(i)%t1%arr1(:,:) = 0
+end do
+
+!$acc enter data copyin(var3)
+!$acc enter data copyin(var3%t2(:))
+!$acc enter data copyin(var3%t2(5)%t1)
+!$acc data copyin(var3%t2(5)%t1%arr1)
+
+!$acc serial present(var3%t2(5)%t1%arr1)
+var3%t2(5)%t1%arr1(:,:) = 6
+!$acc end serial
+
+!$acc update host(var3%t2(5)%t1%arr1)
+
+!$acc end data
+!$acc exit data delete(var3%t2(5)%t1)
+!$acc exit data delete(var3%t2)
+!$acc exit data delete(var3)
+
+do i=1,20
+ if (i.eq.5) then
+ if (any(var3%t2(i)%t1%arr1.ne.6)) stop 5
+ else
+ if (any(var3%t2(i)%t1%arr1.ne.0)) stop 6
+ end if
+end do
+
+end
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/update-dt-array.f90 b/libgomp/testsuite/libgomp.oacc-fortran/update-dt-array.f90
new file mode 100644
index 000000000000..d796eddceda5
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/update-dt-array.f90
@@ -0,0 +1,53 @@
+! { dg-do run }
+
+program myprog
+
+ type mytype
+ integer, allocatable :: myarr(:,:)
+ end type mytype
+ integer :: i
+
+ type(mytype), allocatable :: typearr(:)
+
+ allocate(typearr(1:100))
+
+ do i=1,100
+ allocate(typearr(i)%myarr(1:100,1:100))
+ end do
+
+ do i=1,100
+ typearr(i)%myarr(:,:) = 0
+ end do
+
+ !$acc enter data copyin(typearr)
+
+ do i=1,100
+ !$acc enter data copyin(typearr(i)%myarr)
+ end do
+
+ i=33
+ typearr(i)%myarr(:,:) = 50
+
+ !$acc update device(typearr(i)%myarr(:,:))
+
+ do i=1,100
+ !$acc exit data copyout(typearr(i)%myarr)
+ end do
+
+ !$acc exit data delete(typearr)
+
+ do i=1,100
+ if (i.eq.33) then
+ if (any(typearr(i)%myarr.ne.50)) stop 1
+ else
+ if (any(typearr(i)%myarr.ne.0)) stop 2
+ end if
+ end do
+
+ do i=1,100
+ deallocate(typearr(i)%myarr)
+ end do
+
+ deallocate(typearr)
+
+end program myprog
--
2.29.2
next prev parent reply other threads:[~2021-02-24 21:58 UTC|newest]
Thread overview: 3+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-02-24 21:58 [PATCH 5/7] [og10] Fortran: %re/%im fixes for OpenMP/OpenACC + gfc_is_simplify_contiguous Julian Brown
2021-02-24 21:58 ` Julian Brown [this message]
2021-02-24 21:58 ` [PATCH 7/7] [og10] openacc: Strided array sections and components of derived-type arrays Julian Brown
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20210224215838.130807-2-julian@codesourcery.com \
--to=julian@codesourcery.com \
--cc=fortran@gcc.gnu.org \
--cc=gcc-patches@gcc.gnu.org \
--cc=tobias@codesourcery.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).