From: Tobias Burnus <tobias@codesourcery.com>
To: Julian Brown <julian@codesourcery.com>, <gcc-patches@gcc.gnu.org>,
<fortran@gcc.gnu.org>
Cc: Jakub Jelinek <jakub@redhat.com>,
Thomas Schwinge <thomas@codesourcery.com>
Subject: Re: [PATCH 1/2] openacc: Fix lowering for derived-type mappings through array elements
Date: Tue, 16 Feb 2021 11:08:37 +0100 [thread overview]
Message-ID: <063fe564-7a03-e322-b9e4-3d64902d6fa4@codesourcery.com> (raw)
In-Reply-To: <20210212154649.96393-2-julian@codesourcery.com>
On 12.02.21 16:46, Julian Brown wrote:
> 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.
>
> OK for mainline?
LGTM.
Thanks,
Tobias
> 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.
> ---
> gcc/fortran/trans-openmp.c | 192 ++++++++++--------
> gcc/gimplify.c | 12 ++
> .../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 +-
> .../derivedtypes-arrays-1.f90 | 109 ++++++++++
> .../libgomp.oacc-fortran/update-dt-array.f90 | 53 +++++
> 11 files changed, 344 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/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
> index 249b3de2cfd..67e370f8b57 100644
> --- a/gcc/fortran/trans-openmp.c
> +++ b/gcc/fortran/trans-openmp.c
> @@ -2675,6 +2675,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))
> @@ -2911,74 +2937,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)
> {
> @@ -2987,24 +3018,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)));
> @@ -3035,9 +3072,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. */
> @@ -3131,27 +3167,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 95d55bb8ba4..62fb6370819 100644
> --- a/gcc/gimplify.c
> +++ b/gcc/gimplify.c
> @@ -9406,6 +9406,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/gfortran.dg/goacc/array-with-dt-1.f90 b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-1.f90
> new file mode 100644
> index 00000000000..4a3ff0ef3a7
> --- /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 00000000000..dcb63657f2b
> --- /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 00000000000..637d5f57e1c
> --- /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 00000000000..900587b7eaf
> --- /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 f7aafbfc036..e4d360e1262 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 e22fc679df2..cca6443e7fc 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 e6cf09c6d3c..85a2e1d373d 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/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90
> new file mode 100644
> index 00000000000..644ad1f6b2f
> --- /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 00000000000..d796eddceda
> --- /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
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf
next prev parent reply other threads:[~2021-02-16 10:08 UTC|newest]
Thread overview: 8+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-02-12 15:46 [PATCH 0/2] openacc: Mixing array elements and derived types (mk2) Julian Brown
2021-02-12 15:46 ` [PATCH 1/2] openacc: Fix lowering for derived-type mappings through array elements Julian Brown
2021-02-16 10:08 ` Tobias Burnus [this message]
2021-03-25 11:54 ` Thomas Schwinge
2021-03-26 14:29 ` Thomas Schwinge
2021-02-12 15:46 ` [PATCH 2/2] openacc: Strided array sections and components of derived-type arrays Julian Brown
2021-02-16 10:09 ` Tobias Burnus
2021-02-17 14:18 ` 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=063fe564-7a03-e322-b9e4-3d64902d6fa4@codesourcery.com \
--to=tobias@codesourcery.com \
--cc=fortran@gcc.gnu.org \
--cc=gcc-patches@gcc.gnu.org \
--cc=jakub@redhat.com \
--cc=julian@codesourcery.com \
--cc=thomas@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).