Re: [PATCH 1/4] openacc: Remove dereference for non-pointer derived-type members

Re: [PATCH 1/4] openacc: Remove dereference for non-pointer derived-type members

[Tobias Burnus]

(added fortran@ at it is about Fortran)

I note that some lines in the testcase are commented (polymorphic
arrays), but I note further that Patch 3/4 enables them.

On 02.02.21 14:28, Julian Brown wrote:
> Derived-type members that are themselves derived types are not always
> represented as pointers, so it is not always correct to dereference
> them. The attached test case fails during gimplification without this
> patch.
> Tested with offloading to AMD GCN. OK for mainline?
>
> 2020-02-02  Julian Brown  <julian@codesourcery.com>
>
> gcc/fortran/
>       * trans-openmp.c (gfc_trans_omp_clauses): Handle non-pointer type.
>
> gcc/testsuite/
>       * gfortran.dg/goacc/derived-classtypes-1.f95: New test.
> ---
>   gcc/fortran/trans-openmp.c                    |   7 +-
>   .../goacc/derived-classtypes-1.f95            | 129 ++++++++++++++++++
>   2 files changed, 134 insertions(+), 2 deletions(-)
>   create mode 100644 gcc/testsuite/gfortran.dg/goacc/derived-classtypes-1.f95
>
> diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
> index 00358ca4d39..8d8da4593c3 100644
> --- a/gcc/fortran/trans-openmp.c
> +++ b/gcc/fortran/trans-openmp.c
> @@ -3013,7 +3013,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>                           }
>
>                         OMP_CLAUSE_DECL (node)
> -                         = build_fold_indirect_ref (data);
> +                         = (POINTER_TYPE_P (TREE_TYPE (data))
> +                            ? build_fold_indirect_ref (data) : data);
>                         OMP_CLAUSE_SIZE (node) = size;
>                         node2 = build_omp_clause (input_location,
>                                                   OMP_CLAUSE_MAP);

I am a bit surprised given that:
                       if (sym_attr.pointer || (openacc && sym_attr.allocatable))

I wonder whether we have a size problem:
                               data = inner;
                               size = TYPE_SIZE_UNIT (TREE_TYPE (inner));

Testing shows that it fails for:
    80 | !$acc enter data copyin(jim%f)
    95 | !$acc enter data copyin(pjim%f)
   110 | !$acc enter data copyin(cjim%f)
   125 | !$acc enter data copyin(acjim%f)

where the component is 'type(aux), pointer :: f'.

As sizeof(void*) and 2*sizeof(int) is the same, it does not
matter in this case, but I fear it might in other cases.
('aux' contains two 'integer', one direct and one by inheriting
it from 'aux1'.)

Otherwise, I think the patch is fine. However, it also might be
useful to add some character tests (kind=1 and kind=4) for
completeness.

NOTE: character(len=:), allocatable/pointer is the most interesting
case, but that fails due to https://gcc.gnu.org/PR95868.
Thus, we can only test for len=<const>.

Tobias

> @@ -3021,7 +3022,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>                                                  openacc
>                                                  ? GOMP_MAP_ATTACH_DETACH
>                                                  : GOMP_MAP_ALWAYS_POINTER);
> -                       OMP_CLAUSE_DECL (node2) = data;
> +                       OMP_CLAUSE_DECL (node2)
> +                         = (POINTER_TYPE_P (TREE_TYPE (data))
> +                            ? data : build_fold_addr_expr (data));
>                         OMP_CLAUSE_SIZE (node2) = size_int (0);
>                       }
>                     else
> diff --git a/gcc/testsuite/gfortran.dg/goacc/derived-classtypes-1.f95 b/gcc/testsuite/gfortran.dg/goacc/derived-classtypes-1.f95
> new file mode 100644
> index 00000000000..e6cf09c6d3c
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/goacc/derived-classtypes-1.f95
> @@ -0,0 +1,129 @@
> +type :: type1
> +  integer :: a
> +end type type1
> +
> +type :: type2
> +  integer, pointer :: b
> +end type type2
> +
> +type :: aux1
> +  integer :: y
> +end type aux1
> +
> +type, extends(aux1) :: aux
> +  integer :: x
> +end type aux
> +
> +type :: type3
> +  class(aux), pointer :: c(:)
> +end type type3
> +
> +type :: type4
> +  integer, pointer :: d(:)
> +end type type4
> +
> +type :: type5
> +  type(aux) :: e
> +end type type5
> +
> +type :: type6
> +  type(aux), pointer :: f
> +end type type6
> +
> +type :: type7
> +  class(aux), pointer :: g
> +end type type7
> +
> +type(type1) :: foo
> +type(type2) :: bar
> +type(type3) :: qux
> +type(type4) :: quux
> +type(type5) :: fred
> +type(type6) :: jim
> +type(type7) :: shiela
> +
> +type(type1), pointer :: pfoo
> +type(type2), pointer :: pbar
> +type(type3), pointer :: pqux
> +type(type4), pointer :: pquux
> +type(type5), pointer :: pfred
> +type(type6), pointer :: pjim
> +type(type7), pointer :: pshiela
> +
> +class(type1), pointer :: cfoo
> +class(type2), pointer :: cbar
> +class(type3), pointer :: cqux
> +class(type4), pointer :: cquux
> +class(type5), pointer :: cfred
> +class(type6), pointer :: cjim
> +class(type7), pointer :: cshiela
> +
> +class(type1), allocatable :: acfoo
> +class(type2), allocatable :: acbar
> +class(type3), allocatable :: acqux
> +class(type4), allocatable :: acquux
> +class(type5), allocatable :: acfred
> +class(type6), allocatable :: acjim
> +class(type7), allocatable :: acshiela
> +
> +!$acc enter data copyin(foo)
> +!$acc enter data copyin(foo%a)
> +!$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(quux)
> +!$acc enter data copyin(quux%d)
> +!$acc enter data copyin(fred)
> +!$acc enter data copyin(fred%e)
> +!$acc enter data copyin(jim)
> +!$acc enter data copyin(jim%f)
> +!$acc enter data copyin(shiela)
> +!$acc enter data copyin(shiela%g)
> +
> +!$acc enter data copyin(pfoo)
> +!$acc enter data copyin(pfoo%a)
> +!$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(pquux)
> +!$acc enter data copyin(pquux%d)
> +!$acc enter data copyin(pfred)
> +!$acc enter data copyin(pfred%e)
> +!$acc enter data copyin(pjim)
> +!$acc enter data copyin(pjim%f)
> +!$acc enter data copyin(pshiela)
> +!$acc enter data copyin(pshiela%g)
> +
> +!$acc enter data copyin(cfoo)
> +!$acc enter data copyin(cfoo%a)
> +!$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(cquux)
> +!$acc enter data copyin(cquux%d)
> +!$acc enter data copyin(cfred)
> +!$acc enter data copyin(cfred%e)
> +!$acc enter data copyin(cjim)
> +!$acc enter data copyin(cjim%f)
> +!$acc enter data copyin(cshiela)
> +!$acc enter data copyin(cshiela%g)
> +
> +!$acc enter data copyin(acfoo)
> +!$acc enter data copyin(acfoo%a)
> +!$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(acquux)
> +!$acc enter data copyin(acquux%d)
> +!$acc enter data copyin(acfred)
> +!$acc enter data copyin(acfred%e)
> +!$acc enter data copyin(acjim)
> +!$acc enter data copyin(acjim%f)
> +!$acc enter data copyin(acshiela)
> +!$acc enter data copyin(acshiela%g)
> +
> +end
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf

Re: [PATCH 2/4] openacc: Use class_pointer instead of pointer attribute for class types

[Tobias Burnus]

On 02.02.21 14:28, Julian Brown wrote:

> Elsewhere in the Fortran front-end, the class_pointer attribute is
> used for BT_CLASS entities instead of the pointer attribute. [...]This patch
> follows suit for OpenACC. I couldn't actually come up with a test case
> where this makes a difference (i.e., where "class_pointer" and "pointer"
> have different values at this point in the code), but this may nonetheless
> fix a latent bug.
>
> Tested with offloading to AMD GCN. OK for mainline?

I think attr.pointer == true != attr.class_pointer only happens
for dummy arguments and select-type temporaries, neither of which
can occur for derived-type components.

Thus, I think it is not needed – but there are merits of having
consistency. Hence, OK.

Tobias

> 2020-02-02  Julian Brown<julian@codesourcery.com>
>
> gcc/fortran/
>       * trans-openmp.c (gfc_trans_omp_clauses): Use class_pointer attribute
>       for BT_CLASS.
> ---
>   gcc/fortran/trans-openmp.c | 5 ++++-
>   1 file changed, 4 insertions(+), 1 deletion(-)
>
> diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
> index 8d8da4593c3..7be34ef9a35 100644
> --- a/gcc/fortran/trans-openmp.c
> +++ b/gcc/fortran/trans-openmp.c
> @@ -2997,7 +2997,10 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>                 if (lastcomp->u.c.component->ts.type == BT_DERIVED
>                     || lastcomp->u.c.component->ts.type == BT_CLASS)
>                   {
> -                   if (sym_attr.pointer || (openacc && sym_attr.allocatable))
> +                   bool pointer
> +                     = (lastcomp->u.c.component->ts.type == BT_CLASS
> +                        ? sym_attr.class_pointer : sym_attr.pointer);
> +                   if (pointer || (openacc && sym_attr.allocatable))
>                       {
>                         tree data, size;
>
> -- 2.29.2
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf

Re: [PATCH 1/4] openacc: Remove dereference for non-pointer derived-type members

[Julian Brown]

[-- Attachment #1: Type: text/plain, Size: 1936 bytes --]

Hi Tobias,

Thanks for review! Comments below.

On Tue, 2 Feb 2021 17:32:03 +0100
Tobias Burnus <tobias@codesourcery.com> wrote:

> > diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
> > index 00358ca4d39..8d8da4593c3 100644
> > --- a/gcc/fortran/trans-openmp.c
> > +++ b/gcc/fortran/trans-openmp.c
> > @@ -3013,7 +3013,8 @@ gfc_trans_omp_clauses (stmtblock_t *block,
> > gfc_omp_clauses *clauses, }
> >   
> >   			  OMP_CLAUSE_DECL (node)
> > -			    = build_fold_indirect_ref (data);
> > +			    = (POINTER_TYPE_P (TREE_TYPE (data))
> > +			       ? build_fold_indirect_ref (data) :
> > data); OMP_CLAUSE_SIZE (node) = size;
> >   			  node2 = build_omp_clause
> > (input_location, OMP_CLAUSE_MAP);  
> 
> I am a bit surprised given that:
>                        if (sym_attr.pointer || (openacc &&
> sym_attr.allocatable))
> 
> I wonder whether we have a size problem:
>                                data = inner;
>                                size = TYPE_SIZE_UNIT (TREE_TYPE
> (inner));

I think the code was correct wrt. data sizes, but the logic was
admittedly rather convoluted. I think the attached is better -- the
essential "weirdness" of the previous patch is that it seemed like a
BT_DERIVED-typed "inner" could either be a pointer or not, and likewise
for the BT_CLASS case.

Actually though, that wasn't true. All the non-POINTER_TYPE_P cases
involve BT_DERIVED, because the decl is transparently dereferenced
by the earlier gfc_conv_component_ref call. BT_CLASS pointers, however,
were not dereferenced -- so "data" appeared as an actual pointer. The
pre-patch code actually only worked in the BT_CLASS case.

So, I think the new version makes more sense. (The "size" field is
either transparently dereferenced via gfc_conv_component_ref, or comes
from the class's vtable, so it's never the size of the non-dereferenced
pointer.)

Re-tested with offloading to AMD GCN. OK?

Thank you,

Julian

[-- Attachment #2: 0001-openacc-Dereference-BT_CLASS-data-pointers-but-not-B.patch --]
[-- Type: text/x-patch, Size: 5732 bytes --]

From 158f733899caa59c1cb9f53a14fa0544ae3e8878 Mon Sep 17 00:00:00 2001
From: Julian Brown <julian@codesourcery.com>
Date: Fri, 29 Jan 2021 15:37:27 -0800
Subject: [PATCH] openacc: Dereference BT_CLASS data pointers but not
 BT_DERIVED pointers

The stanza in gfc_trans_omp_clauses that handles derived type members
that are themselves derived type pointers or class pointers now adds
an explicit dereference only for the latter. The former is already
dereferenced transparently in gfc_conv_component_ref.

gcc/fortran/
	* trans-openmp.c (gfc_trans_omp_clauses): Fix dereferencing for
	BT_DERIVED members.

gcc/testsuite/
	* gfortran.dg/goacc/derived-classtypes-1.f95: New test.
---
 gcc/fortran/trans-openmp.c                    |   7 +-
 .../goacc/derived-classtypes-1.f95            | 129 ++++++++++++++++++
 2 files changed, 133 insertions(+), 3 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/derived-classtypes-1.f95

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 00358ca4d39..a5fe0e76af2 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -3004,6 +3004,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			  if (lastcomp->u.c.component->ts.type == BT_CLASS)
 			    {
 			      data = gfc_class_data_get (inner);
+			      gcc_assert (POINTER_TYPE_P (TREE_TYPE (data)));
+			      data = build_fold_indirect_ref (data);
 			      size = gfc_class_vtab_size_get (inner);
 			    }
 			  else  /* BT_DERIVED.  */
@@ -3012,8 +3014,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			      size = TYPE_SIZE_UNIT (TREE_TYPE (inner));
 			    }
 
-			  OMP_CLAUSE_DECL (node)
-			    = build_fold_indirect_ref (data);
+			  OMP_CLAUSE_DECL (node) = data;
 			  OMP_CLAUSE_SIZE (node) = size;
 			  node2 = build_omp_clause (input_location,
 						    OMP_CLAUSE_MAP);
@@ -3021,7 +3022,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 						   openacc
 						   ? GOMP_MAP_ATTACH_DETACH
 						   : GOMP_MAP_ALWAYS_POINTER);
-			  OMP_CLAUSE_DECL (node2) = data;
+			  OMP_CLAUSE_DECL (node2) = build_fold_addr_expr (data);
 			  OMP_CLAUSE_SIZE (node2) = size_int (0);
 			}
 		      else
diff --git a/gcc/testsuite/gfortran.dg/goacc/derived-classtypes-1.f95 b/gcc/testsuite/gfortran.dg/goacc/derived-classtypes-1.f95
new file mode 100644
index 00000000000..e6cf09c6d3c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/derived-classtypes-1.f95
@@ -0,0 +1,129 @@
+type :: type1
+  integer :: a
+end type type1
+
+type :: type2
+  integer, pointer :: b
+end type type2
+
+type :: aux1
+  integer :: y
+end type aux1
+
+type, extends(aux1) :: aux
+  integer :: x
+end type aux
+
+type :: type3
+  class(aux), pointer :: c(:)
+end type type3
+
+type :: type4
+  integer, pointer :: d(:)
+end type type4
+
+type :: type5
+  type(aux) :: e
+end type type5
+
+type :: type6
+  type(aux), pointer :: f
+end type type6
+
+type :: type7
+  class(aux), pointer :: g
+end type type7
+
+type(type1) :: foo
+type(type2) :: bar
+type(type3) :: qux
+type(type4) :: quux
+type(type5) :: fred
+type(type6) :: jim
+type(type7) :: shiela
+
+type(type1), pointer :: pfoo
+type(type2), pointer :: pbar
+type(type3), pointer :: pqux
+type(type4), pointer :: pquux
+type(type5), pointer :: pfred
+type(type6), pointer :: pjim
+type(type7), pointer :: pshiela
+
+class(type1), pointer :: cfoo
+class(type2), pointer :: cbar
+class(type3), pointer :: cqux
+class(type4), pointer :: cquux
+class(type5), pointer :: cfred
+class(type6), pointer :: cjim
+class(type7), pointer :: cshiela
+
+class(type1), allocatable :: acfoo
+class(type2), allocatable :: acbar
+class(type3), allocatable :: acqux
+class(type4), allocatable :: acquux
+class(type5), allocatable :: acfred
+class(type6), allocatable :: acjim
+class(type7), allocatable :: acshiela
+
+!$acc enter data copyin(foo)
+!$acc enter data copyin(foo%a)
+!$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(quux)
+!$acc enter data copyin(quux%d)
+!$acc enter data copyin(fred)
+!$acc enter data copyin(fred%e)
+!$acc enter data copyin(jim)
+!$acc enter data copyin(jim%f)
+!$acc enter data copyin(shiela)
+!$acc enter data copyin(shiela%g)
+
+!$acc enter data copyin(pfoo)
+!$acc enter data copyin(pfoo%a)
+!$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(pquux)
+!$acc enter data copyin(pquux%d)
+!$acc enter data copyin(pfred)
+!$acc enter data copyin(pfred%e)
+!$acc enter data copyin(pjim)
+!$acc enter data copyin(pjim%f)
+!$acc enter data copyin(pshiela)
+!$acc enter data copyin(pshiela%g)
+
+!$acc enter data copyin(cfoo)
+!$acc enter data copyin(cfoo%a)
+!$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(cquux)
+!$acc enter data copyin(cquux%d)
+!$acc enter data copyin(cfred)
+!$acc enter data copyin(cfred%e)
+!$acc enter data copyin(cjim)
+!$acc enter data copyin(cjim%f)
+!$acc enter data copyin(cshiela)
+!$acc enter data copyin(cshiela%g)
+
+!$acc enter data copyin(acfoo)
+!$acc enter data copyin(acfoo%a)
+!$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(acquux)
+!$acc enter data copyin(acquux%d)
+!$acc enter data copyin(acfred)
+!$acc enter data copyin(acfred%e)
+!$acc enter data copyin(acjim)
+!$acc enter data copyin(acjim%f)
+!$acc enter data copyin(acshiela)
+!$acc enter data copyin(acshiela%g)
+
+end
-- 
2.29.2

Re: [PATCH 1/4] openacc: Remove dereference for non-pointer derived-type members

[Tobias Burnus]

Hi Julian,

LGTM. Thanks!

  * * *

Can you as follow-up also add a testcase which uses – instead of integer –
'character' (with len > 1, both kind=1 and kind=4) and check that it is
handled correctly? In particular, that the right size is passed on.
(Should be size-in-bytes = kind*len.) It probably just work, unless any
OpenACC construct uses a different code path than the one covered by my
OpenMP patches (esp. https://gcc.gnu.org/g:102502e32ea4e8a75d6b252ba319d09d735d9aa7 ).

('character' (esp. kind=4 or len=: (¹)) and 'class' have the tendency to
break. Not that allocatable/pointer/optional don't expose bugs.)

Tobias

(¹) Bug regarding (len=:) in components ishttps://gcc.gnu.org/PR95868.

On 04.02.21 14:58, Julian Brown wrote:
> Thanks for review! Comments below.
> [...]
> I think the code was correct wrt. data sizes, but the logic was
> admittedly rather convoluted. I think the attached is better -- the
> essential "weirdness" of the previous patch is that it seemed like a
> BT_DERIVED-typed "inner" could either be a pointer or not, and likewise
> for the BT_CLASS case.
>
> Actually though, that wasn't true. All the non-POINTER_TYPE_P cases
> involve BT_DERIVED, because the decl is transparently dereferenced
> by the earlier gfc_conv_component_ref call. BT_CLASS pointers, however,
> were not dereferenced -- so "data" appeared as an actual pointer. The
> pre-patch code actually only worked in the BT_CLASS case.
>
> So, I think the new version makes more sense. (The "size" field is
> either transparently dereferenced via gfc_conv_component_ref, or comes
> from the class's vtable, so it's never the size of the non-dereferenced
> pointer.)
>
> Re-tested with offloading to AMD GCN. OK?
>
> Thank you,
>
> Julian
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf

Re: [PATCH 4/4] openacc: Allow strided arrays in update directives

[Julian Brown]

[-- Attachment #1: Type: text/plain, Size: 332 bytes --]

On Thu, 4 Feb 2021 16:03:44 +0100
Tobias Burnus <tobias@codesourcery.com> wrote:

> LGTM.
> 
> However, I'd feel better if there were a testcase, which actually
> checks that it works correctly. (I think that means a
> libgomp/testsuite/ run test.)

Thanks! FYI, I've committed this version with an additional runtime
test.

Julian

[-- Attachment #2: 0003-openacc-Allow-strided-arrays-in-update-directives.patch --]
[-- Type: text/x-patch, Size: 3979 bytes --]

From 9a4d32f85ccebc0ee4b24e6d9d7a4f11c04d7146 Mon Sep 17 00:00:00 2001
From: Julian Brown <julian@codesourcery.com>
Date: Tue, 2 Feb 2021 03:44:34 -0800
Subject: [PATCH 3/4] openacc: Allow strided arrays in update directives

OpenACC 3.0 ("2.14.4. Update Directive") states:

  Noncontiguous subarrays may appear. It is implementation-specific
  whether noncontiguous regions are updated by using one transfer for
  each contiguous subregion, or whether the non-contiguous data is
  packed, transferred once, and unpacked, or whether one or more larger
  subarrays (no larger than the smallest contiguous region that contains
  the specified subarray) are updated.

This patch relaxes some conditions in the Fortran front-end so that
strided accesses are permitted for update directives.

gcc/fortran/
	* openmp.c (resolve_omp_clauses): Omit OpenACC update in
	contiguity check and stride-specified error.

gcc/testsuite/
	* gfortran.dg/goacc/array-with-dt-2.f90: New test.

libgomp/
	* testsuite/libgomp.oacc-fortran/array-stride-dt-1.f90: New test.
---
 gcc/fortran/openmp.c                          |  5 ++-
 .../gfortran.dg/goacc/array-with-dt-2.f90     | 10 +++++
 .../array-stride-dt-1.f90                     | 44 +++++++++++++++++++
 3 files changed, 57 insertions(+), 2 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/array-with-dt-2.f90
 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/array-stride-dt-1.f90

diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index aab17f0589f..797f6c86b62 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -5192,7 +5192,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 			   array isn't contiguous.  An expression such as
 			   arr(-n:n,-n:n) could be contiguous even if it looks
 			   like it may not be.  */
-			if (list != OMP_LIST_CACHE
+			if (code->op != EXEC_OACC_UPDATE
+			    && list != OMP_LIST_CACHE
 			    && list != OMP_LIST_DEPEND
 			    && !gfc_is_simply_contiguous (n->expr, false, true)
 			    && gfc_is_not_contiguous (n->expr))
@@ -5230,7 +5231,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 			int i;
 			gfc_array_ref *ar = &array_ref->u.ar;
 			for (i = 0; i < ar->dimen; i++)
-			  if (ar->stride[i])
+			  if (ar->stride[i] && code->op != EXEC_OACC_UPDATE)
 			    {
 			      gfc_error ("Stride should not be specified for "
 					 "array section in %s clause at %L",
diff --git a/gcc/testsuite/gfortran.dg/goacc/array-with-dt-2.f90 b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-2.f90
new file mode 100644
index 00000000000..807580d75a9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-2.f90
@@ -0,0 +1,10 @@
+type t
+   integer, allocatable :: A(:,:)
+end type t
+
+type(t), allocatable :: b(:)
+
+!$acc update host(b(::2))
+!$acc update host(b(1)%A(::3,::4))
+end
+
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/array-stride-dt-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/array-stride-dt-1.f90
new file mode 100644
index 00000000000..f04d76d583a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/array-stride-dt-1.f90
@@ -0,0 +1,44 @@
+! { dg-do run }
+
+type t
+   integer, allocatable :: A(:,:)
+end type t
+
+type(t), allocatable :: b(:)
+
+integer :: i
+
+allocate(b(1:20))
+do i=1,20
+  allocate(b(i)%A(1:20,1:20))
+end do
+
+do i=1,20
+  b(i)%A(:,:) = 0
+end do
+
+!$acc enter data copyin(b)
+do i=1,20
+  !$acc enter data copyin(b(i)%A)
+end do
+
+b(1)%A(:,:) = 5
+
+!$acc update device(b(::2))
+!$acc update device(b(1)%A(::3,::4))
+
+do i=1,20
+  !$acc exit data copyout(b(i)%A)
+end do
+!$acc exit data copyout(b)
+
+! This is necessarily conservative because the "update" is allowed to copy
+! e.g. the whole of the containing block for a discontinuous update.
+! Try to ensure that the update covers a sufficient portion of the array.
+
+if (any(b(1)%A(::3,::4) .ne. 5)) stop 1
+do i=2,20
+  if (any(b(i)%A(:,:) .ne. 0)) stop 2
+end do
+
+end
-- 
2.29.2

Re: [PATCH 1/4] openacc: Remove dereference for non-pointer derived-type members

[Julian Brown]

[-- Attachment #1: Type: text/plain, Size: 897 bytes --]

On Thu, 4 Feb 2021 15:55:20 +0100
Tobias Burnus <tobias@codesourcery.com> wrote:

> Hi Julian,
> 
> LGTM. Thanks!
> 
>   * * *
> 
> Can you as follow-up also add a testcase which uses – instead of
> integer – 'character' (with len > 1, both kind=1 and kind=4) and
> check that it is handled correctly? In particular, that the right
> size is passed on. (Should be size-in-bytes = kind*len.) It probably
> just work, unless any OpenACC construct uses a different code path
> than the one covered by my OpenMP patches (esp.
> https://gcc.gnu.org/g:102502e32ea4e8a75d6b252ba319d09d735d9aa7 ).
> 
> ('character' (esp. kind=4 or len=: (¹)) and 'class' have the tendency
> to break. Not that allocatable/pointer/optional don't expose bugs.)

Thanks, I've committed the patch, and also the attached patch with some
additional character tests. All seems good, AFAICT.

Julian

[-- Attachment #2: 0004-openacc-Tests-for-character-types-in-derived-type-ma.patch --]
[-- Type: text/x-patch, Size: 10576 bytes --]

From b2d84e9f9cccbe4ee662f7002b83105629d09939 Mon Sep 17 00:00:00 2001
From: Julian Brown <julian@codesourcery.com>
Date: Thu, 4 Feb 2021 10:13:22 -0800
Subject: [PATCH 4/4] openacc: Tests for character types in derived-type
 mappings

This patch adds some tests for character types that are components of
derived types used in OpenACC data-movement clauses.

gcc/testsuite/
	* gfortran.dg/goacc/derived-chartypes-1.f90: New test.
	* gfortran.dg/goacc/derived-chartypes-2.f90: Likewise.
	* gfortran.dg/goacc/derived-chartypes-3.f90: Likewise.
	* gfortran.dg/goacc/derived-chartypes-4.f90: Likewise.
---
 .../gfortran.dg/goacc/derived-chartypes-1.f90 | 129 ++++++++++++++++++
 .../gfortran.dg/goacc/derived-chartypes-2.f90 | 129 ++++++++++++++++++
 .../gfortran.dg/goacc/derived-chartypes-3.f90 |  38 ++++++
 .../gfortran.dg/goacc/derived-chartypes-4.f90 |  38 ++++++
 4 files changed, 334 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/derived-chartypes-1.f90
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/derived-chartypes-2.f90
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/derived-chartypes-3.f90
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/derived-chartypes-4.f90

diff --git a/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-1.f90 b/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-1.f90
new file mode 100644
index 00000000000..e4d360e1262
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-1.f90
@@ -0,0 +1,129 @@
+type :: type1
+  character(len=35) :: a
+end type type1
+
+type :: type2
+  character(len=35), pointer :: b
+end type type2
+
+type :: aux1
+  character(len=22) :: y
+end type aux1
+
+type, extends(aux1) :: aux
+  character(len=33) :: x
+end type aux
+
+type :: type3
+  class(aux), pointer :: c(:)
+end type type3
+
+type :: type4
+  integer, pointer :: d(:)
+end type type4
+
+type :: type5
+  type(aux1) :: e
+end type type5
+
+type :: type6
+  type(aux1), pointer :: f
+end type type6
+
+type :: type7
+  class(aux), pointer :: g
+end type type7
+
+type(type1) :: foo
+type(type2) :: bar
+type(type3) :: qux
+type(type4) :: quux
+type(type5) :: fred
+type(type6) :: jim
+type(type7) :: shiela
+
+type(type1), pointer :: pfoo
+type(type2), pointer :: pbar
+type(type3), pointer :: pqux
+type(type4), pointer :: pquux
+type(type5), pointer :: pfred
+type(type6), pointer :: pjim
+type(type7), pointer :: pshiela
+
+class(type1), pointer :: cfoo
+class(type2), pointer :: cbar
+class(type3), pointer :: cqux
+class(type4), pointer :: cquux
+class(type5), pointer :: cfred
+class(type6), pointer :: cjim
+class(type7), pointer :: cshiela
+
+class(type1), allocatable :: acfoo
+class(type2), allocatable :: acbar
+class(type3), allocatable :: acqux
+class(type4), allocatable :: acquux
+class(type5), allocatable :: acfred
+class(type6), allocatable :: acjim
+class(type7), allocatable :: acshiela
+
+!$acc enter data copyin(foo)
+!$acc enter data copyin(foo%a)
+!$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(quux)
+!$acc enter data copyin(quux%d)
+!$acc enter data copyin(fred)
+!$acc enter data copyin(fred%e)
+!$acc enter data copyin(jim)
+!$acc enter data copyin(jim%f)
+!$acc enter data copyin(shiela)
+!$acc enter data copyin(shiela%g)
+
+!$acc enter data copyin(pfoo)
+!$acc enter data copyin(pfoo%a)
+!$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(pquux)
+!$acc enter data copyin(pquux%d)
+!$acc enter data copyin(pfred)
+!$acc enter data copyin(pfred%e)
+!$acc enter data copyin(pjim)
+!$acc enter data copyin(pjim%f)
+!$acc enter data copyin(pshiela)
+!$acc enter data copyin(pshiela%g)
+
+!$acc enter data copyin(cfoo)
+!$acc enter data copyin(cfoo%a)
+!$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(cquux)
+!$acc enter data copyin(cquux%d)
+!$acc enter data copyin(cfred)
+!$acc enter data copyin(cfred%e)
+!$acc enter data copyin(cjim)
+!$acc enter data copyin(cjim%f)
+!$acc enter data copyin(cshiela)
+!$acc enter data copyin(cshiela%g)
+
+!$acc enter data copyin(acfoo)
+!$acc enter data copyin(acfoo%a)
+!$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(acquux)
+!$acc enter data copyin(acquux%d)
+!$acc enter data copyin(acfred)
+!$acc enter data copyin(acfred%e)
+!$acc enter data copyin(acjim)
+!$acc enter data copyin(acjim%f)
+!$acc enter data copyin(acshiela)
+!$acc enter data copyin(acshiela%g)
+
+end
diff --git a/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-2.f90 b/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-2.f90
new file mode 100644
index 00000000000..cca6443e7fc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-2.f90
@@ -0,0 +1,129 @@
+type :: type1
+  character(len=35,kind=4) :: a
+end type type1
+
+type :: type2
+  character(len=35,kind=4), pointer :: b
+end type type2
+
+type :: aux1
+  character(len=22,kind=4) :: y
+end type aux1
+
+type, extends(aux1) :: aux
+  character(len=33,kind=4) :: x
+end type aux
+
+type :: type3
+  class(aux), pointer :: c(:)
+end type type3
+
+type :: type4
+  integer, pointer :: d(:)
+end type type4
+
+type :: type5
+  type(aux1) :: e
+end type type5
+
+type :: type6
+  type(aux1), pointer :: f
+end type type6
+
+type :: type7
+  class(aux), pointer :: g
+end type type7
+
+type(type1) :: foo
+type(type2) :: bar
+type(type3) :: qux
+type(type4) :: quux
+type(type5) :: fred
+type(type6) :: jim
+type(type7) :: shiela
+
+type(type1), pointer :: pfoo
+type(type2), pointer :: pbar
+type(type3), pointer :: pqux
+type(type4), pointer :: pquux
+type(type5), pointer :: pfred
+type(type6), pointer :: pjim
+type(type7), pointer :: pshiela
+
+class(type1), pointer :: cfoo
+class(type2), pointer :: cbar
+class(type3), pointer :: cqux
+class(type4), pointer :: cquux
+class(type5), pointer :: cfred
+class(type6), pointer :: cjim
+class(type7), pointer :: cshiela
+
+class(type1), allocatable :: acfoo
+class(type2), allocatable :: acbar
+class(type3), allocatable :: acqux
+class(type4), allocatable :: acquux
+class(type5), allocatable :: acfred
+class(type6), allocatable :: acjim
+class(type7), allocatable :: acshiela
+
+!$acc enter data copyin(foo)
+!$acc enter data copyin(foo%a)
+!$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(quux)
+!$acc enter data copyin(quux%d)
+!$acc enter data copyin(fred)
+!$acc enter data copyin(fred%e)
+!$acc enter data copyin(jim)
+!$acc enter data copyin(jim%f)
+!$acc enter data copyin(shiela)
+!$acc enter data copyin(shiela%g)
+
+!$acc enter data copyin(pfoo)
+!$acc enter data copyin(pfoo%a)
+!$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(pquux)
+!$acc enter data copyin(pquux%d)
+!$acc enter data copyin(pfred)
+!$acc enter data copyin(pfred%e)
+!$acc enter data copyin(pjim)
+!$acc enter data copyin(pjim%f)
+!$acc enter data copyin(pshiela)
+!$acc enter data copyin(pshiela%g)
+
+!$acc enter data copyin(cfoo)
+!$acc enter data copyin(cfoo%a)
+!$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(cquux)
+!$acc enter data copyin(cquux%d)
+!$acc enter data copyin(cfred)
+!$acc enter data copyin(cfred%e)
+!$acc enter data copyin(cjim)
+!$acc enter data copyin(cjim%f)
+!$acc enter data copyin(cshiela)
+!$acc enter data copyin(cshiela%g)
+
+!$acc enter data copyin(acfoo)
+!$acc enter data copyin(acfoo%a)
+!$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(acquux)
+!$acc enter data copyin(acquux%d)
+!$acc enter data copyin(acfred)
+!$acc enter data copyin(acfred%e)
+!$acc enter data copyin(acjim)
+!$acc enter data copyin(acjim%f)
+!$acc enter data copyin(acshiela)
+!$acc enter data copyin(acshiela%g)
+
+end
diff --git a/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-3.f90 b/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-3.f90
new file mode 100644
index 00000000000..2bab497cef5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-3.f90
@@ -0,0 +1,38 @@
+! { dg-additional-options "-fdump-tree-gimple" }
+
+type :: type1
+  character(len=35) :: a
+end type type1
+
+type :: type2
+  character(len=46), pointer :: b
+end type type2
+
+type(type1) :: foo
+type(type2) :: bar
+
+type(type1), pointer :: pfoo
+type(type2), pointer :: pbar
+
+class(type1), pointer :: cfoo
+class(type2), pointer :: cbar
+
+class(type1), allocatable :: acfoo
+class(type2), allocatable :: acbar
+
+!$acc enter data copyin(foo%a)
+!$acc enter data copyin(bar%b)
+
+!$acc enter data copyin(pfoo%a)
+!$acc enter data copyin(pbar%b)
+
+!$acc enter data copyin(cfoo%a)
+!$acc enter data copyin(cbar%b)
+
+!$acc enter data copyin(acfoo%a)
+!$acc enter data copyin(acbar%b)
+
+! { dg-final { scan-tree-dump-times "to:\[^\\\[\]*\\\[len: 35\\\]" 4 "gimple" } }
+! { dg-final { scan-tree-dump-times "to:\[^\\\[\]*\\\[len: 46\\\]" 4 "gimple" } }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-4.f90 b/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-4.f90
new file mode 100644
index 00000000000..cfe40066a59
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-4.f90
@@ -0,0 +1,38 @@
+! { dg-additional-options "-fdump-tree-gimple" }
+
+type :: type1
+  character(len=35,kind=4) :: a
+end type type1
+
+type :: type2
+  character(len=46,kind=4), pointer :: b
+end type type2
+
+type(type1) :: foo
+type(type2) :: bar
+
+type(type1), pointer :: pfoo
+type(type2), pointer :: pbar
+
+class(type1), pointer :: cfoo
+class(type2), pointer :: cbar
+
+class(type1), allocatable :: acfoo
+class(type2), allocatable :: acbar
+
+!$acc enter data copyin(foo%a)
+!$acc enter data copyin(bar%b)
+
+!$acc enter data copyin(pfoo%a)
+!$acc enter data copyin(pbar%b)
+
+!$acc enter data copyin(cfoo%a)
+!$acc enter data copyin(cbar%b)
+
+!$acc enter data copyin(acfoo%a)
+!$acc enter data copyin(acbar%b)
+
+! { dg-final { scan-tree-dump-times "to:\[^\\\[\]*\\\[len: 140\\\]" 4 "gimple" } }
+! { dg-final { scan-tree-dump-times "to:\[^\\\[\]*\\\[len: 184\\\]" 4 "gimple" } }
+
+end
-- 
2.29.2

Re: [PATCH 3/4] openacc: Fix lowering for derived-type mappings through array elements

[Tobias Burnus]

(CC fortran@)

Hi Julian,

not doing an extensive review yet, but the following gives an ICE
with this patch applied. (I believe the others are already in, aren't they?)

type t
  integer :: i, j
end type t
type t2
  type(t) :: b(4)
end type
type(t2) :: var(10)
!$acc update host(var(3)%b(:)%j)
!$acc update host(var(3)%b%j)
end

That's a noncontiguous array – which is permitted for 'update'
and it gives an ICE via:

0x9b0c59 gfc_conv_scalarized_array_ref
         ../../repos/gcc/gcc/fortran/trans-array.c:3570
0x9b2134 gfc_conv_array_ref(gfc_se*, gfc_array_ref*, gfc_expr*, locus*)
         ../../repos/gcc/gcc/fortran/trans-array.c:3721
0x9e9cc6 gfc_conv_variable
         ../../repos/gcc/gcc/fortran/trans-expr.c:2998
0xa22682 gfc_trans_omp_clauses
         ../../repos/gcc/gcc/fortran/trans-openmp.c:2963

  * * *

> +           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;
> +                 }
> +             }
> +

I am not sure how the rest will change, but I was wondering
whether the following helps. I see that 'lastref' is used
elsewhere – hence, I am not sure whether it is indeed better.

symbol_attribute attr = {};
if (n->expr)
   attr = gfc_expr_attr (n->expr);

(Not really looked at the rest before wondering whether
my testcase above is handled – which isn't.)

Tobias

-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf

Re: [PATCH 3/4] openacc: Fix lowering for derived-type mappings through array elements

[Julian Brown]

[-- Attachment #1: Type: text/plain, Size: 2101 bytes --]

On Fri, 5 Feb 2021 17:25:10 +0100
Tobias Burnus <tobias@codesourcery.com> wrote:

> (CC fortran@)
> 
> Hi Julian,
> 
> not doing an extensive review yet, but the following gives an ICE
> with this patch applied. (I believe the others are already in, aren't
> they?)
> 
> type t
>   integer :: i, j
> end type t
> type t2
>   type(t) :: b(4)
> end type
> type(t2) :: var(10)
> !$acc update host(var(3)%b(:)%j)
> !$acc update host(var(3)%b%j)
> end
> 
> That's a noncontiguous array – which is permitted for 'update'
> and it gives an ICE via:
> 
> 0x9b0c59 gfc_conv_scalarized_array_ref
>          ../../repos/gcc/gcc/fortran/trans-array.c:3570
> 0x9b2134 gfc_conv_array_ref(gfc_se*, gfc_array_ref*, gfc_expr*,
> locus*) ../../repos/gcc/gcc/fortran/trans-array.c:3721
> 0x9e9cc6 gfc_conv_variable
>          ../../repos/gcc/gcc/fortran/trans-expr.c:2998
> 0xa22682 gfc_trans_omp_clauses
>          ../../repos/gcc/gcc/fortran/trans-openmp.c:2963

I think the attached patch fixes that. (This could be merged into the
parent patch or kept separate, not sure which is better.)

Re-tested with offloading to AMD GCN. OK?

> > +	      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;
> > +		    }
> > +		}
> > +  
> 
> I am not sure how the rest will change, but I was wondering
> whether the following helps. I see that 'lastref' is used
> elsewhere – hence, I am not sure whether it is indeed better.
>   
> symbol_attribute attr = {};
> if (n->expr)
>    attr = gfc_expr_attr (n->expr);

Ah, I didn't know about that one! But yeah, not sure if it's better
here.

Thanks for (pre-)review!

Julian

[-- Attachment #2: 0001-Handle-discontinuous-ranges-with-derived-types.patch --]
[-- Type: text/x-patch, Size: 4476 bytes --]

From adf4221bf5b5ab01ce1ed264226f1799d8aa0b05 Mon Sep 17 00:00:00 2001
From: Julian Brown <julian@codesourcery.com>
Date: Sat, 6 Feb 2021 02:34:30 -0800
Subject: [PATCH] Handle discontinuous ranges with derived types

OpenACC "update" allows discontiguous ranges to be specified, e.g. by
selecting an array slice in the middle of a derived type selector list:

  !$acc update host(mytype%arraymember(:)%foo)

We handle this by transferring the whole of the slice and ignoring the
"foo" part.

gcc/fortran/
	* trans-openmp.c (gfc_trans_omp_clauses): Handle discontiguous
	ranges specified by arrays or array slices with trailing
	derived-type selectors.

gcc/testsuite/
	* gfortran.dg/goacc/array-with-dt-6.f90: New test.

libgomp/
	* testsuite/gfortran.dg/update-dt-array-2.f90: New test.
---
 gcc/fortran/trans-openmp.c                    | 26 +++++++-
 .../gfortran.dg/goacc/array-with-dt-6.f90     | 10 ++++
 .../update-dt-array-2.f90                     | 59 +++++++++++++++++++
 3 files changed, 93 insertions(+), 2 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/array-with-dt-6.f90
 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/update-dt-array-2.f90

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 67e370f8b57..758485e0c7d 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -2676,12 +2676,32 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 	      if (DECL_P (decl))
 		TREE_ADDRESSABLE (decl) = 1;
 
-	      gfc_ref *lastref = NULL;
+	      gfc_ref *lastref = NULL, *lastslice = NULL;
 
 	      if (n->expr)
 		for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
-		  if (ref->type == REF_COMPONENT || ref->type == REF_ARRAY)
+		  if (ref->type == REF_COMPONENT)
 		    lastref = ref;
+		  else if (ref->type == REF_ARRAY)
+		    {
+		      if (ref->u.ar.type == AR_FULL
+			  || ref->u.ar.type == AR_SECTION)
+			lastslice = ref;
+
+		      lastref = ref;
+		    }
+
+	      /* If a slice is specified but it is not the last ref, this
+		 might be an update operation that allows discontiguous
+		 regions, like:
+
+		   myvar%slice(:)%foo
+
+		 in that case, we will ignore the %foo part and transfer the
+		 whole of the slice as a single block.  */
+
+	      if (lastslice)
+		lastref = lastslice;
 
 	      bool allocatable = false, pointer = false;
 
@@ -3023,6 +3043,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			  if (ref->u.ar.type == AR_ELEMENT && ref->next)
 			    gfc_conv_array_ref (&se, &ref->u.ar, n->expr,
 						&n->expr->where);
+			  else if (ref == lastslice)
+			    break;
 			  else
 			    gcc_assert (!ref->next);
 			}
diff --git a/gcc/testsuite/gfortran.dg/goacc/array-with-dt-6.f90 b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-6.f90
new file mode 100644
index 00000000000..260db6602f4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-6.f90
@@ -0,0 +1,10 @@
+type t
+  integer :: i, j
+end type t
+type t2
+  type(t) :: b(4)
+end type
+type(t2) :: var(10)
+!$acc update host(var(3)%b(:)%j)
+!$acc update host(var(3)%b%j)
+end
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/update-dt-array-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/update-dt-array-2.f90
new file mode 100644
index 00000000000..8e0ed338d39
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/update-dt-array-2.f90
@@ -0,0 +1,59 @@
+! { dg-do run }
+
+program myprog
+
+  type mt2
+    integer :: p, q, r
+  end type mt2
+
+  type mytype
+    type(mt2), 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(:,:)%p = 0
+    typearr(i)%myarr(:,:)%q = 0
+    typearr(i)%myarr(:,:)%r = 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(:,:)%q = 50
+
+  !$acc update device(typearr(i)%myarr(:,:)%q)
+
+  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(:,:)%q.ne.50)) stop 1
+    else
+      if (any(typearr(i)%myarr(:,:)%q.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

Re: [PATCH 3/4] openacc: Fix lowering for derived-type mappings through array elements

[Tobias Burnus]

On 06.02.21 11:49, Julian Brown wrote:

>             if (n->expr)
>               for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
> -               if (ref->type == REF_COMPONENT || ref->type == REF_ARRAY)
> +               if (ref->type == REF_COMPONENT)
>                   lastref = ref;
> +               else if (ref->type == REF_ARRAY)

This one fails to build:

../../repos/gcc/gcc/fortran/trans-openmp.c: In function ‘tree_node* gfc_trans_omp_clauses(stmtblock_t*, gfc_omp_clauses*, locus, bool, bool)’:
../../repos/gcc/gcc/fortran/trans-openmp.c:2681:18: error: suggest explicit braces to avoid ambiguous ‘else’ [-Werror=dangling-else]
  2681 |               if (n->expr)
       |                  ^


Previous patch in this 3/4 thread:
> + && !lastref->u.c.component->attr.dimension) + { + /* Derived type
> access with last component being a scalar. */

I was wondering whether that causes any issues with local access to coarrays,
but that seems to work (compile with -fcoarray=single or -fcoarray=lib -lcaf_single);
I have not check the dump whether it indeed works.

(The interesting case is -fcoarray=lib; all those accesses go
to the local variable – remote access (like A[image_idx]) is
correctly rejected with 'List item shall not be coindexed'
or with a parse error.)

implicit none
type t2
   integer :: x, y
end type t2
type t
   type(t2), allocatable :: B[:], BB(:)[:]
end type t
type(t) :: var
type(t2), allocatable :: A[:], AA(:)[:]
type(t2) :: C[*], CC(10)[*]

!$acc update self(var%B, var%BB)
!$acc update self(var%BB(1))
!$acc update self(var%B%x)
!$acc update self(var%BB%x)
!$acc update self(var%BB(1)%x)
!$acc update self(A, AA)
!$acc update self(AA(1))
!$acc update self(A%x, AA%y)
!$acc update self(AA(1)%y)
!$acc update self(C, CC)
!$acc update self(CC(1))
!$acc update self(C%x, CC%y)
!$acc update self(CC(1)%y)
end


> else - sorry ("unhandled derived-type component"); + sorry ("unhandled
> expression type");

Nit: That's not an expression type but a reference type. Remaining
are: REF_SUBSTRING and REF_INQUIRY. I wonder whether that should be 'gcc_unreachable' or 'internal_error'
but 'sorry' does not make sense. I think that message occurs twice.
Otherwise, it looks good to me. Tobias PS: I have a follow-up patch
related to %re/%im or %kind, to be submitted later today.


-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf