From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from esa2.mentor.iphmx.com (esa2.mentor.iphmx.com [68.232.141.98]) by sourceware.org (Postfix) with ESMTPS id B9FC23857C50; Tue, 16 Feb 2021 10:08:49 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org B9FC23857C50 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=Tobias_Burnus@mentor.com IronPort-SDR: 2lty3qp7QyxJMYBRir2T2w9Yo7rv0xLoTEdtnHfIlQYpj+OiTmr/QONl0RFV+MI428Alsuvt9h pO5rvet1zeD+pmYfdAVWh9hN8+npF6zZMdaYh7mvq0M64NqjEl0lRwKWuAp5hdqqetosPcBjwa XeZJ6FQtQ6XlNnbDch/UNUAX/pK8l6nztS9smUmfY2HotOtfnIkgFbicrSTdvn1zZQirQLdM3a DXI49WLFpbNBPhlFk9rWUY6VeuZYohJTkjX2PtFmGBFSWtuasxZaqCXDCX3M9271YT6K3mW5q3 K1U= X-IronPort-AV: E=Sophos;i="5.81,183,1610438400"; d="scan'208";a="58136945" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa2.mentor.iphmx.com with ESMTP; 16 Feb 2021 02:08:47 -0800 IronPort-SDR: q7+2JJlPjBZmYSS2W6cj1gxKxgqNmPzSqW3D7C28hbj4GxFtkNElpVKyZMZ8Tl1xg9YlhnXas6 7AT2xwU3WGzBi+X8+88ZWOe3A+/OnzrT8NDCNFcPA/JNk4DsZsG60A+CsxphAmFPWfy6eUggCa X7m4cSUzb457pYC026l0KdOZGMXlDNRkJkWSAxMZM3hq4Ko/EVTGAE54mNLxdB+p6jyTRfAAcf qUaTwA7HhKwFK18f5DZprryjfz2dTaGsHwZOGvADKcD+ZiXUJgUm+yHJhereP/mlUUj3/0q+Wq O0U= Subject: Re: [PATCH 1/2] openacc: Fix lowering for derived-type mappings through array elements To: Julian Brown , , CC: Jakub Jelinek , Thomas Schwinge References: <20210212154649.96393-1-julian@codesourcery.com> <20210212154649.96393-2-julian@codesourcery.com> From: Tobias Burnus Message-ID: <063fe564-7a03-e322-b9e4-3d64902d6fa4@codesourcery.com> Date: Tue, 16 Feb 2021 11:08:37 +0100 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101 Thunderbird/78.7.1 MIME-Version: 1.0 In-Reply-To: <20210212154649.96393-2-julian@codesourcery.com> Content-Type: text/plain; charset="utf-8"; format=flowed Content-Transfer-Encoding: quoted-printable Content-Language: en-US X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-05.mgc.mentorg.com (139.181.222.5) To svr-ies-mbx-01.mgc.mentorg.com (139.181.222.1) X-Spam-Status: No, score=-12.1 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, NICE_REPLY_A, RCVD_IN_DNSWL_NONE, SPF_HELO_PASS, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: fortran@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Fortran mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Tue, 16 Feb 2021 10:08:52 -0000 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 tes= t. > * 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-arr= ay.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 =3D gfc_trans_omp_variable (n->sym, false); > if (DECL_P (decl)) > TREE_ADDRESSABLE (decl) =3D 1; > + > + gfc_ref *lastref =3D NULL; > + > + if (n->expr) > + for (gfc_ref *ref =3D n->expr->ref; ref; ref =3D ref->next) > + if (ref->type =3D=3D REF_COMPONENT || ref->type =3D=3D RE= F_ARRAY) > + lastref =3D ref; > + > + bool allocatable =3D false, pointer =3D false; > + > + if (lastref && lastref->type =3D=3D REF_COMPONENT) > + { > + gfc_component *c =3D lastref->u.c.component; > + > + if (c->ts.type =3D=3D BT_CLASS) > + { > + pointer =3D CLASS_DATA (c)->attr.class_pointer; > + allocatable =3D CLASS_DATA (c)->attr.allocatable; > + } > + else > + { > + pointer =3D c->attr.pointer; > + allocatable =3D c->attr.allocatable; > + } > + } > + > if (n->expr =3D=3D NULL > || (n->expr->ref->type =3D=3D REF_ARRAY > && n->expr->ref->u.ar.type =3D=3D AR_FULL)) > @@ -2911,74 +2937,79 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_om= p_clauses *clauses, > } > else if (n->expr > && n->expr->expr_type =3D=3D EXPR_VARIABLE > - && n->expr->ref->type =3D=3D REF_COMPONENT) > + && n->expr->ref->type =3D=3D REF_ARRAY > + && !n->expr->ref->next) > { > - gfc_ref *lastcomp; > - > - for (gfc_ref *ref =3D n->expr->ref; ref; ref =3D ref->nex= t) > - if (ref->type =3D=3D REF_COMPONENT) > - lastcomp =3D ref; > - > - symbol_attribute sym_attr; > - > - if (lastcomp->u.c.component->ts.type =3D=3D BT_CLASS) > - sym_attr =3D CLASS_DATA (lastcomp->u.c.component)->attr= ; > - else > - sym_attr =3D lastcomp->u.c.component->attr; > - > + /* An array element or array section which is not part of= a > + derived type, etc. */ > + bool element =3D n->expr->ref->u.ar.type =3D=3D AR_ELEMEN= T; > + gfc_trans_omp_array_section (block, n, decl, element, > + GOMP_MAP_POINTER, node, node= 2, > + node3, node4); > + } > + else if (n->expr > + && n->expr->expr_type =3D=3D EXPR_VARIABLE > + && (n->expr->ref->type =3D=3D REF_COMPONENT > + || n->expr->ref->type =3D=3D REF_ARRAY) > + && lastref > + && lastref->type =3D=3D REF_COMPONENT > + && lastref->u.c.component->ts.type !=3D BT_CLASS > + && lastref->u.c.component->ts.type !=3D 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 !=3D BT_CLASS > - && lastcomp->u.c.component->ts.type !=3D 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) > + =3D 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 =3D build_omp_clause (input_location, > + OMP_CLAUSE_MAP); > + gomp_map_kind kind > + =3D (openacc ? GOMP_MAP_ATTACH_DETACH > + : GOMP_MAP_ALWAYS_POINTER); > + OMP_CLAUSE_SET_MAP_KIND (node2, kind); > + OMP_CLAUSE_DECL (node2) > =3D 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) =3D size_int (0); > + if (!openacc > + && n->expr->ts.type =3D=3D BT_CHARACTER > + && n->expr->ts.deferred) > { > - node2 =3D build_omp_clause (input_location, > + gcc_assert (se.string_length); > + tree tmp > + =3D gfc_get_char_type (n->expr->ts.kind); > + OMP_CLAUSE_SIZE (node) > + =3D fold_build2 (MULT_EXPR, size_type_node, > + fold_convert (size_type_node, > + se.string_length), > + TYPE_SIZE_UNIT (tmp)); > + node3 =3D build_omp_clause (input_location, > OMP_CLAUSE_MAP); > - OMP_CLAUSE_SET_MAP_KIND (node2, > - openacc > - ? GOMP_MAP_ATTACH_DETACH > - : GOMP_MAP_ALWAYS_POINTE= R); > - OMP_CLAUSE_DECL (node2) > - =3D POINTER_TYPE_P (TREE_TYPE (se.expr)) > - ? se.expr : gfc_build_addr_expr (NULL, se.ex= pr); > - OMP_CLAUSE_SIZE (node2) =3D size_int (0); > - if (!openacc > - && n->expr->ts.type =3D=3D BT_CHARACTER > - && n->expr->ts.deferred) > - { > - gcc_assert (se.string_length); > - tree tmp =3D gfc_get_char_type (n->expr->ts.k= ind); > - OMP_CLAUSE_SIZE (node) > - =3D fold_build2 (MULT_EXPR, size_type_node, > - fold_convert (size_type_node= , > - se.string_leng= th), > - TYPE_SIZE_UNIT (tmp)); > - node3 =3D build_omp_clause (input_location, > - OMP_CLAUSE_MAP); > - OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_TO); > - OMP_CLAUSE_DECL (node3) =3D se.string_length; > - OMP_CLAUSE_SIZE (node3) > - =3D TYPE_SIZE_UNIT (gfc_charlen_type_node); > - } > + OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_TO); > + OMP_CLAUSE_DECL (node3) =3D se.string_length; > + OMP_CLAUSE_SIZE (node3) > + =3D TYPE_SIZE_UNIT (gfc_charlen_type_node); > } > - goto finalize_map_clause; > } > - > + } > + else if (n->expr > + && n->expr->expr_type =3D=3D EXPR_VARIABLE > + && (n->expr->ref->type =3D=3D REF_COMPONENT > + || n->expr->ref->type =3D=3D REF_ARRAY)) > + { > + gfc_init_se (&se, NULL); > se.expr =3D gfc_maybe_dereference_var (n->sym, decl); > > - for (gfc_ref *ref =3D n->expr->ref; > - ref && ref !=3D lastcomp->next; > - ref =3D ref->next) > + for (gfc_ref *ref =3D n->expr->ref; ref; ref =3D ref->nex= t) > { > if (ref->type =3D=3D REF_COMPONENT) > { > @@ -2987,24 +3018,30 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_om= p_clauses *clauses, > > gfc_conv_component_ref (&se, ref); > } > + else if (ref->type =3D=3D REF_ARRAY) > + { > + if (ref->u.ar.type =3D=3D 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 =3D se.expr; > > /* Last component is a derived type or class pointer. */ > - if (lastcomp->u.c.component->ts.type =3D=3D BT_DERIVED > - || lastcomp->u.c.component->ts.type =3D=3D BT_CLASS) > + if (lastref->type =3D=3D REF_COMPONENT > + && (lastref->u.c.component->ts.type =3D=3D BT_DERIVED > + || lastref->u.c.component->ts.type =3D=3D BT_CLAS= S)) > { > - bool pointer > - =3D (lastcomp->u.c.component->ts.type =3D=3D BT_CLA= SS > - ? 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 =3D=3D BT_CL= ASS) > + if (lastref->u.c.component->ts.type =3D=3D BT_CLA= SS) > { > data =3D 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, > =3D TYPE_SIZE_UNIT (TREE_TYPE (inner)); > } > } > - else if (lastcomp->next > - && lastcomp->next->type =3D=3D REF_ARRAY > - && lastcomp->next->u.ar.type =3D=3D AR_FULL) > + else if (lastref->type =3D=3D REF_ARRAY > + && lastref->u.ar.type =3D=3D 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_om= p_clauses *clauses, > else > OMP_CLAUSE_DECL (node) =3D inner; > } > - else /* An array element or section. */ > + else if (lastref->type =3D=3D REF_ARRAY) > { > - bool element > - =3D (lastcomp->next > - && lastcomp->next->type =3D=3D REF_ARRAY > - && lastcomp->next->u.ar.type =3D=3D AR_ELEMENT); > - > + /* An array element or section. */ > + bool element =3D lastref->u.ar.type =3D=3D AR_ELEMENT= ; > gomp_map_kind kind =3D (openacc ? GOMP_MAP_ATTACH_DET= ACH > : GOMP_MAP_ALWAYS_POINT= ER); > 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 =3D n->expr->ref->u.ar.type =3D=3D AR_ELEMEN= T; > - gfc_trans_omp_array_section (block, n, decl, element, > - GOMP_MAP_POINTER, node, node= 2, > - 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_se= q *pre_p, > } > } > } > + else if ((code =3D=3D OACC_ENTER_DATA > + || code =3D=3D OACC_EXIT_DATA > + || code =3D=3D OACC_DATA > + || code =3D=3D OACC_PARALLEL > + || code =3D=3D OACC_KERNELS > + || code =3D=3D OACC_SERIAL) > + && OMP_CLAUSE_MAP_KIND (c) =3D=3D GOMP_MAP_ATTACH_DE= TACH) > + { > + gomp_map_kind k =3D (code =3D=3D 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_lval= ue) > =3D=3D GS_ERROR) > diff --git a/gcc/testsuite/gfortran.dg/goacc/array-with-dt-1.f90 b/gcc/te= stsuite/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/te= stsuite/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/te= stsuite/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/te= stsuite/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/gc= c/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=3D35) :: a > end type type1 > diff --git a/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-2.f90 b/gc= c/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=3D35,kind=3D4) :: a > end type type1 > diff --git a/gcc/testsuite/gfortran.dg/goacc/derived-classtypes-1.f95 b/g= cc/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=3D1,20 > + allocate(var1(i)%t3(1:20)) > + do j=3D1,20 > + do k=3D1,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=3D1,20 > + do j=3D1,20 > + allocate(var2%t3(i)%t2(j)%t1%arr1(1:20,1:20)) > + end do > +end do > + > +do i=3D1,20 > + do j=3D1,20 > + do k=3D1,20 > + var1(i)%t3(j)%t2(k)%t1%arr1(:,:) =3D 0 > + end do > + var2%t3(i)%t2(j)%t1%arr1(:,:) =3D 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(:,:) =3D 5 > +var1(5)%t3(4)%t2(3)%t1%arr1(:,:) =3D 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=3D1,20 > + do j=3D1,20 > + do k=3D1,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=3D1,20 > + allocate(var3%t2(i)%t1%arr1(1:20, 1:20)) > + var3%t2(i)%t1%arr1(:,:) =3D 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(:,:) =3D 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=3D1,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=3D1,100 > + allocate(typearr(i)%myarr(1:100,1:100)) > + end do > + > + do i=3D1,100 > + typearr(i)%myarr(:,:) =3D 0 > + end do > + > + !$acc enter data copyin(typearr) > + > + do i=3D1,100 > + !$acc enter data copyin(typearr(i)%myarr) > + end do > + > + i=3D33 > + typearr(i)%myarr(:,:) =3D 50 > + > + !$acc update device(typearr(i)%myarr(:,:)) > + > + do i=3D1,100 > + !$acc exit data copyout(typearr(i)%myarr) > + end do > + > + !$acc exit data delete(typearr) > + > + do i=3D1,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=3D1,100 > + deallocate(typearr(i)%myarr) > + end do > + > + deallocate(typearr) > + > +end program myprog ----------------- Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 M=C3=BCnchen R= egistergericht M=C3=BCnchen HRB 106955, Gesch=C3=A4ftsf=C3=BChrer: Thomas H= eurung, Frank Th=C3=BCrauf