[PATCH 0/2] openacc: Mixing array elements and derived types (mk2)

[PATCH 0/2] openacc: Mixing array elements and derived types (mk2)

[Julian Brown]

This series contains an updated version of the "3/4" patch from this
series:

  https://gcc.gnu.org/pipermail/gcc-patches/2021-February/564711.html

together with bits that undo the reversions in:

  https://gcc.gnu.org/pipermail/gcc-patches/2021-February/565093.html

and a new approach to handling components of array sections of derived
types, since those are actually already explicitly disallowed by the spec
(OpenACC 3.0).

(Actually the 1/2 patch is the same as the previously-posted version,
apart from testsuite changes.)

Re-tested with offloading to AMD GCN. Further commentary on individual
patches. OK?

Thanks,

Julian

Julian Brown (2):
  openacc: Fix lowering for derived-type mappings through array elements
  openacc: Strided array sections and components of derived-type arrays

 gcc/fortran/openmp.c                          |  55 ++---
 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-2.f90     |   5 +-
 .../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/array-with-dt-6.f90     |  10 +
 .../gfortran.dg/goacc/derived-chartypes-1.f90 |   3 -
 .../gfortran.dg/goacc/derived-chartypes-2.f90 |   3 -
 .../goacc/derived-classtypes-1.f95            |   8 +-
 .../gfortran.dg/goacc/mapping-tests-2.f90     |   4 +-
 .../array-stride-dt-1.f90                     |   5 +-
 .../derivedtypes-arrays-1.f90                 | 109 ++++++++++
 .../libgomp.oacc-fortran/update-dt-array.f90  |  53 +++++
 16 files changed, 392 insertions(+), 122 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 gcc/testsuite/gfortran.dg/goacc/array-with-dt-6.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

-- 
2.29.2

[PATCH 1/2] openacc: Fix lowering for derived-type mappings through array elements

[Julian Brown]

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?

Thanks,

Julian

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
-- 
2.29.2

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

[Tobias Burnus]

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

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

[Thomas Schwinge]

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

Hi!

On 2021-02-12T07:46:48-0800, Julian Brown <julian@codesourcery.com> wrote:
> --- /dev/null
> +++ b/libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90
> @@ -0,0 +1,109 @@
> +[...]
> +!$acc serial present(var3%t2(5)%t1%arr1)
> +var3%t2(5)%t1%arr1(:,:) = 6
> +!$acc end serial
> +[...]

I've pushed "'libgomp.oacc-fortran/derivedtypes-arrays-1.f90' OpenACC
'serial' construct diagnostic for nvptx offloading" to master branch in
commit 8bafce1be11a301c2421483736c634b8bf330e69, and cherry-picked into
devel/omp/gcc-10 branch in commit
c89b23b73edeeb7e3d8cbad278e505c2d6d770c4, see attached.


Grüße
 Thomas


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

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-libgomp.oacc-fortran-derivedtypes-arrays-1.f90-OpenA.patch --]
[-- Type: text/x-diff, Size: 1512 bytes --]

From 8bafce1be11a301c2421483736c634b8bf330e69 Mon Sep 17 00:00:00 2001
From: Thomas Schwinge <thomas@codesourcery.com>
Date: Thu, 11 Mar 2021 10:52:59 +0100
Subject: [PATCH] 'libgomp.oacc-fortran/derivedtypes-arrays-1.f90' OpenACC
 'serial' construct diagnostic for nvptx offloading

Fixup for recent commit d28f3da11d8c0aed9b746689d723022a9b5ec04c "openacc: Fix
lowering for derived-type mappings through array elements".  With nvptx
offloading we see the usual:

    [...]/libgomp.oacc-fortran/derivedtypes-arrays-1.f90: In function 'MAIN__._omp_fn.0':
    [...]/libgomp.oacc-fortran/derivedtypes-arrays-1.f90:90:40: warning: using vector_length (32), ignoring 1

	libgomp/
	* testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90:
	OpenACC 'serial' construct diagnostic for nvptx offloading.
---
 libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90 | 1 +
 1 file changed, 1 insertion(+)

diff --git a/libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90
index 644ad1f6b2fc..7bca2df66285 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90
@@ -88,6 +88,7 @@ end do
 !$acc data copyin(var3%t2(5)%t1%arr1)
 
 !$acc serial present(var3%t2(5)%t1%arr1)
+! { dg-warning "using vector_length \\(32\\), ignoring 1" "" { target openacc_nvidia_accel_selected } .-1 }
 var3%t2(5)%t1%arr1(:,:) = 6
 !$acc end serial
 
-- 
2.30.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-libgomp.oacc-fortran-derivedtypes-arrays-1.f90-.og10.patch --]
[-- Type: text/x-diff, Size: 2086 bytes --]

From c89b23b73edeeb7e3d8cbad278e505c2d6d770c4 Mon Sep 17 00:00:00 2001
From: Thomas Schwinge <thomas@codesourcery.com>
Date: Thu, 11 Mar 2021 10:52:59 +0100
Subject: [PATCH] 'libgomp.oacc-fortran/derivedtypes-arrays-1.f90' OpenACC
 'serial' construct diagnostic for nvptx offloading

Fixup for recent commit d28f3da11d8c0aed9b746689d723022a9b5ec04c "openacc: Fix
lowering for derived-type mappings through array elements".  With nvptx
offloading we see the usual:

    [...]/libgomp.oacc-fortran/derivedtypes-arrays-1.f90: In function 'MAIN__._omp_fn.0':
    [...]/libgomp.oacc-fortran/derivedtypes-arrays-1.f90:90:40: warning: using vector_length (32), ignoring 1

	libgomp/
	* testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90:
	OpenACC 'serial' construct diagnostic for nvptx offloading.

(cherry picked from commit 8bafce1be11a301c2421483736c634b8bf330e69)
---
 libgomp/ChangeLog.omp                                          | 3 +++
 .../testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90   | 1 +
 2 files changed, 4 insertions(+)

diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp
index 19f48dc61202..05788d5c27a2 100644
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/ChangeLog.omp
@@ -1,5 +1,8 @@
 2021-03-25  Thomas Schwinge  <thomas@codesourcery.com>
 
+	* testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90:
+	OpenACC 'serial' construct diagnostic for nvptx offloading.
+
 	* plugin/plugin-hsa.c (GOMP_OFFLOAD_supported_features): New
 	function.
 
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90
index 644ad1f6b2fc..7bca2df66285 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90
@@ -88,6 +88,7 @@ end do
 !$acc data copyin(var3%t2(5)%t1%arr1)
 
 !$acc serial present(var3%t2(5)%t1%arr1)
+! { dg-warning "using vector_length \\(32\\), ignoring 1" "" { target openacc_nvidia_accel_selected } .-1 }
 var3%t2(5)%t1%arr1(:,:) = 6
 !$acc end serial
 
-- 
2.30.2

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

[Thomas Schwinge]

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

Hi!

On 2021-03-25T12:54:31+0100, I wrote:
> On 2021-02-12T07:46:48-0800, Julian Brown <julian@codesourcery.com> wrote:
>> --- /dev/null
>> +++ b/libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90
>> @@ -0,0 +1,109 @@
>> +[...]
>> +!$acc serial present(var3%t2(5)%t1%arr1)
>> +var3%t2(5)%t1%arr1(:,:) = 6
>> +!$acc end serial
>> +[...]
>
> I've pushed "'libgomp.oacc-fortran/derivedtypes-arrays-1.f90' OpenACC
> 'serial' construct diagnostic for nvptx offloading" to master branch in
> commit 8bafce1be11a301c2421483736c634b8bf330e69, and cherry-picked into
> devel/omp/gcc-10 branch in commit
> c89b23b73edeeb7e3d8cbad278e505c2d6d770c4, see attached.

I'd pushed the wrong thing to devel/omp/gcc-10 branch, so I've now pushed
"Adjust 'libgomp.oacc-fortran/derivedtypes-arrays-1.f90' for og10" in
commit 4777cf66403e311ff3f00bf3d9a60bd5b546f5ed, see attached.


Grüße
 Thomas


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

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Adjust-libgomp.oacc-fortran-derivedtypes-arrays.og10.patch --]
[-- Type: text/x-diff, Size: 1945 bytes --]

From 4777cf66403e311ff3f00bf3d9a60bd5b546f5ed Mon Sep 17 00:00:00 2001
From: Thomas Schwinge <thomas@codesourcery.com>
Date: Fri, 26 Mar 2021 15:19:49 +0100
Subject: [PATCH] Adjust 'libgomp.oacc-fortran/derivedtypes-arrays-1.f90' for
 og10

This is a fix-up for og10 commit c89b23b73edeeb7e3d8cbad278e505c2d6d770c4
"'libgomp.oacc-fortran/derivedtypes-arrays-1.f90' OpenACC 'serial' construct
diagnostic for nvptx offloading".

We're missing in og10 a few patches related to diagnostics location
tracking/checking, both compiler-side and testsuite-side.

	libgomp/
	* testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90: Adjust
	for og10.
---
 libgomp/ChangeLog.omp                                        | 5 +++++
 .../testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90 | 2 +-
 2 files changed, 6 insertions(+), 1 deletion(-)

diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp
index b0af9c205a38..f131c2c79b7e 100644
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/ChangeLog.omp
@@ -1,3 +1,8 @@
+2021-03-26  Thomas Schwinge  <thomas@codesourcery.com>
+
+	* testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90: Adjust
+	for og10.
+
 2021-03-25  Kwok Cheung Yeung  <kcy@codesourcery.com>
 
 	Backport from mainline
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90
index 7bca2df66285..0208e07ea937 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90
@@ -88,7 +88,7 @@ end do
 !$acc data copyin(var3%t2(5)%t1%arr1)
 
 !$acc serial present(var3%t2(5)%t1%arr1)
-! { dg-warning "using vector_length \\(32\\), ignoring 1" "" { target openacc_nvidia_accel_selected } .-1 }
+! { dg-warning "using vector_length \\(32\\), ignoring 1" "" { target openacc_nvidia_accel_selected } 92 }
 var3%t2(5)%t1%arr1(:,:) = 6
 !$acc end serial
 
-- 
2.30.2

[PATCH 2/2] openacc: Strided array sections and components of derived-type arrays

[Julian Brown]

This patch disallows selecting components of array sections in update
directives for OpenACC, as specified in OpenACC 3.0, "2.14.4. Update
Directive", "Restrictions":

  "In Fortran, members of variables of derived type may appear, including
   a subarray of a member. Members of subarrays of derived type may
   not appear."

The diagnostic for attempting to use the same construct on other
directives has also been improved.

OK for mainline?

Thanks,

Julian

gcc/fortran/
	* openmp.c (resolve_omp_clauses): Disallow selecting components of
	arrays of derived type.

gcc/testsuite/
	* gfortran.dg/goacc/array-with-dt-2.f90: Remove expected errors.
	* gfortran.dg/goacc/array-with-dt-6.f90: New test.
	* gfortran.dg/goacc/mapping-tests-2.f90: Update expected error.

libgomp/
	* testsuite/libgomp.oacc-fortran/array-stride-dt-1.f90: Remove expected
	errors.
---
 gcc/fortran/openmp.c                          | 55 +++++++++++--------
 .../gfortran.dg/goacc/array-with-dt-2.f90     |  5 +-
 .../gfortran.dg/goacc/array-with-dt-6.f90     | 10 ++++
 .../gfortran.dg/goacc/mapping-tests-2.f90     |  4 +-
 .../array-stride-dt-1.f90                     |  5 +-
 5 files changed, 48 insertions(+), 31 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/array-with-dt-6.f90

diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index aab17f0589f..9bcb1bf62ca 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -5174,17 +5174,29 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 				 "are allowed on ORDERED directive at %L",
 				 &n->where);
 		  }
-		gfc_ref *array_ref = NULL;
+		gfc_ref *lastref = NULL, *lastslice = NULL;
 		bool resolved = false;
 		if (n->expr)
 		  {
-		    array_ref = n->expr->ref;
+		    lastref = n->expr->ref;
 		    resolved = gfc_resolve_expr (n->expr);
 
 		    /* Look through component refs to find last array
 		       reference.  */
 		    if (resolved)
 		      {
+			for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
+			  if (ref->type == REF_COMPONENT)
+			    lastref = ref;
+			  else if (ref->type == REF_ARRAY)
+			    {
+			      for (int i = 0; i < ref->u.ar.dimen; i++)
+				if (ref->u.ar.dimen_type[i] == DIMEN_RANGE)
+				  lastslice = ref;
+
+			      lastref = ref;
+			    }
+
 			/* The "!$acc cache" directive allows rectangular
 			   subarrays to be specified, with some restrictions
 			   on the form of bounds (not implemented).
@@ -5192,45 +5204,42 @@ 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))
+			    && gfc_is_not_contiguous (n->expr)
+			    && !(lastslice
+				 && (lastslice->next
+				     || lastslice->type != REF_ARRAY)))
 			  gfc_error ("Array is not contiguous at %L",
 				     &n->where);
-
-			while (array_ref
-			       && (array_ref->type == REF_COMPONENT
-				   || (array_ref->type == REF_ARRAY
-				       && array_ref->next
-				       && (array_ref->next->type
-					   == REF_COMPONENT))))
-			  array_ref = array_ref->next;
 		      }
 		  }
-		if (array_ref
+		if (lastref
 		    || (n->expr
 			&& (!resolved || n->expr->expr_type != EXPR_VARIABLE)))
 		  {
-		    if (array_ref
-			&& (array_ref->type == REF_SUBSTRING
-			    || (array_ref->next
-				&& array_ref->next->type == REF_SUBSTRING)))
+		    if (lastref
+			&& (lastref->type == REF_SUBSTRING
+			    || (lastref->next
+				&& lastref->next->type == REF_SUBSTRING)))
 		      gfc_error ("Unexpected substring reference in %s clause "
 				 "at %L", name, &n->where);
 		    else if (!resolved
-			|| n->expr->expr_type != EXPR_VARIABLE
-			|| array_ref->next
-			|| array_ref->type != REF_ARRAY)
+			     || n->expr->expr_type != EXPR_VARIABLE
+			     || (lastslice
+				 && (lastslice->next
+				     || lastslice->type != REF_ARRAY)))
 		      gfc_error ("%qs in %s clause at %L is not a proper "
 				 "array section", n->sym->name, name,
 				 &n->where);
-		    else
+		    else if (lastslice)
 		      {
 			int i;
-			gfc_array_ref *ar = &array_ref->u.ar;
+			gfc_array_ref *ar = &lastslice->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
index e4a6f319772..807580d75a9 100644
--- a/gcc/testsuite/gfortran.dg/goacc/array-with-dt-2.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-2.f90
@@ -4,8 +4,7 @@ end type t
 
 type(t), allocatable :: b(:)
 
-! TODO: Remove expected errors when this is supported.
-!$acc update host(b(::2))  ! { dg-error "Stride should not be specified for array section in MAP clause" }
-!$acc update host(b(1)%A(::3,::4))  ! { dg-error "Stride should not be specified for array section in MAP clause" }
+!$acc update host(b(::2))
+!$acc update host(b(1)%A(::3,::4))
 end
 
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..adac8e3945e
--- /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)  ! { dg-error "not a proper array section" }
+!$acc update host(var(3)%b%j)  ! { dg-error "not a proper array section" }
+end
diff --git a/gcc/testsuite/gfortran.dg/goacc/mapping-tests-2.f90 b/gcc/testsuite/gfortran.dg/goacc/mapping-tests-2.f90
index 1372f6af53e..6b414fb8524 100644
--- a/gcc/testsuite/gfortran.dg/goacc/mapping-tests-2.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/mapping-tests-2.f90
@@ -24,9 +24,9 @@ subroutine foo
   ! Bad - we cannot do a strided access of 'x'
   ! No C/C++ equivalent
 !$acc enter data copyin(y(:)%i)
-! { dg-error "Array is not contiguous" "" { target "*-*-*" } 26 }
+! { dg-error "not a proper array section" "" { target "*-*-*" } 26 }
 
   ! Bad - again, a strided access
 !$acc enter data copyin(z(1)%cc(:)%i)
-! { dg-error "Array is not contiguous" "" { target "*-*-*" } 30 }
+! { dg-error "not a proper array section" "" { target "*-*-*" } 30 }
 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
index 61250708197..f04d76d583a 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/array-stride-dt-1.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/array-stride-dt-1.f90
@@ -24,9 +24,8 @@ end do
 
 b(1)%A(:,:) = 5
 
-! TODO: Remove expected errors once this is supported.
-!$acc update device(b(::2))  ! { dg-error "Stride should not be specified for array section in MAP clause" }
-!$acc update device(b(1)%A(::3,::4))  ! { dg-error "Stride should not be specified for array section in MAP clause" }
+!$acc update device(b(::2))
+!$acc update device(b(1)%A(::3,::4))
 
 do i=1,20
   !$acc exit data copyout(b(i)%A)
-- 
2.29.2

Re: [PATCH 2/2] openacc: Strided array sections and components of derived-type arrays

[Tobias Burnus]

On 12.02.21 16:46, Julian Brown wrote:
> This patch disallows selecting components of array sections in update
> directives for OpenACC, as specified in OpenACC 3.0, "2.14.4. Update
> Directive", "Restrictions":
>
>    "In Fortran, members of variables of derived type may appear, including
>     a subarray of a member. Members of subarrays of derived type may
>     not appear."
>
> The diagnostic for attempting to use the same construct on other
> directives has also been improved.
>
> OK for mainline?

LGTM.

Tobias

> gcc/fortran/
>       * openmp.c (resolve_omp_clauses): Disallow selecting components of
>       arrays of derived type.
>
> gcc/testsuite/
>       * gfortran.dg/goacc/array-with-dt-2.f90: Remove expected errors.
>       * gfortran.dg/goacc/array-with-dt-6.f90: New test.
>       * gfortran.dg/goacc/mapping-tests-2.f90: Update expected error.
>
> libgomp/
>       * testsuite/libgomp.oacc-fortran/array-stride-dt-1.f90: Remove expected
>       errors.
> ---
>   gcc/fortran/openmp.c                          | 55 +++++++++++--------
>   .../gfortran.dg/goacc/array-with-dt-2.f90     |  5 +-
>   .../gfortran.dg/goacc/array-with-dt-6.f90     | 10 ++++
>   .../gfortran.dg/goacc/mapping-tests-2.f90     |  4 +-
>   .../array-stride-dt-1.f90                     |  5 +-
>   5 files changed, 48 insertions(+), 31 deletions(-)
>   create mode 100644 gcc/testsuite/gfortran.dg/goacc/array-with-dt-6.f90
>
> diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
> index aab17f0589f..9bcb1bf62ca 100644
> --- a/gcc/fortran/openmp.c
> +++ b/gcc/fortran/openmp.c
> @@ -5174,17 +5174,29 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
>                                "are allowed on ORDERED directive at %L",
>                                &n->where);
>                 }
> -             gfc_ref *array_ref = NULL;
> +             gfc_ref *lastref = NULL, *lastslice = NULL;
>               bool resolved = false;
>               if (n->expr)
>                 {
> -                 array_ref = n->expr->ref;
> +                 lastref = n->expr->ref;
>                   resolved = gfc_resolve_expr (n->expr);
>
>                   /* Look through component refs to find last array
>                      reference.  */
>                   if (resolved)
>                     {
> +                     for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
> +                       if (ref->type == REF_COMPONENT)
> +                         lastref = ref;
> +                       else if (ref->type == REF_ARRAY)
> +                         {
> +                           for (int i = 0; i < ref->u.ar.dimen; i++)
> +                             if (ref->u.ar.dimen_type[i] == DIMEN_RANGE)
> +                               lastslice = ref;
> +
> +                           lastref = ref;
> +                         }
> +
>                       /* The "!$acc cache" directive allows rectangular
>                          subarrays to be specified, with some restrictions
>                          on the form of bounds (not implemented).
> @@ -5192,45 +5204,42 @@ 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))
> +                         && gfc_is_not_contiguous (n->expr)
> +                         && !(lastslice
> +                              && (lastslice->next
> +                                  || lastslice->type != REF_ARRAY)))
>                         gfc_error ("Array is not contiguous at %L",
>                                    &n->where);
> -
> -                     while (array_ref
> -                            && (array_ref->type == REF_COMPONENT
> -                                || (array_ref->type == REF_ARRAY
> -                                    && array_ref->next
> -                                    && (array_ref->next->type
> -                                        == REF_COMPONENT))))
> -                       array_ref = array_ref->next;
>                     }
>                 }
> -             if (array_ref
> +             if (lastref
>                   || (n->expr
>                       && (!resolved || n->expr->expr_type != EXPR_VARIABLE)))
>                 {
> -                 if (array_ref
> -                     && (array_ref->type == REF_SUBSTRING
> -                         || (array_ref->next
> -                             && array_ref->next->type == REF_SUBSTRING)))
> +                 if (lastref
> +                     && (lastref->type == REF_SUBSTRING
> +                         || (lastref->next
> +                             && lastref->next->type == REF_SUBSTRING)))
>                     gfc_error ("Unexpected substring reference in %s clause "
>                                "at %L", name, &n->where);
>                   else if (!resolved
> -                     || n->expr->expr_type != EXPR_VARIABLE
> -                     || array_ref->next
> -                     || array_ref->type != REF_ARRAY)
> +                          || n->expr->expr_type != EXPR_VARIABLE
> +                          || (lastslice
> +                              && (lastslice->next
> +                                  || lastslice->type != REF_ARRAY)))
>                     gfc_error ("%qs in %s clause at %L is not a proper "
>                                "array section", n->sym->name, name,
>                                &n->where);
> -                 else
> +                 else if (lastslice)
>                     {
>                       int i;
> -                     gfc_array_ref *ar = &array_ref->u.ar;
> +                     gfc_array_ref *ar = &lastslice->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
> index e4a6f319772..807580d75a9 100644
> --- a/gcc/testsuite/gfortran.dg/goacc/array-with-dt-2.f90
> +++ b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-2.f90
> @@ -4,8 +4,7 @@ end type t
>
>   type(t), allocatable :: b(:)
>
> -! TODO: Remove expected errors when this is supported.
> -!$acc update host(b(::2))  ! { dg-error "Stride should not be specified for array section in MAP clause" }
> -!$acc update host(b(1)%A(::3,::4))  ! { dg-error "Stride should not be specified for array section in MAP clause" }
> +!$acc update host(b(::2))
> +!$acc update host(b(1)%A(::3,::4))
>   end
>
> 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..adac8e3945e
> --- /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)  ! { dg-error "not a proper array section" }
> +!$acc update host(var(3)%b%j)  ! { dg-error "not a proper array section" }
> +end
> diff --git a/gcc/testsuite/gfortran.dg/goacc/mapping-tests-2.f90 b/gcc/testsuite/gfortran.dg/goacc/mapping-tests-2.f90
> index 1372f6af53e..6b414fb8524 100644
> --- a/gcc/testsuite/gfortran.dg/goacc/mapping-tests-2.f90
> +++ b/gcc/testsuite/gfortran.dg/goacc/mapping-tests-2.f90
> @@ -24,9 +24,9 @@ subroutine foo
>     ! Bad - we cannot do a strided access of 'x'
>     ! No C/C++ equivalent
>   !$acc enter data copyin(y(:)%i)
> -! { dg-error "Array is not contiguous" "" { target "*-*-*" } 26 }
> +! { dg-error "not a proper array section" "" { target "*-*-*" } 26 }
>
>     ! Bad - again, a strided access
>   !$acc enter data copyin(z(1)%cc(:)%i)
> -! { dg-error "Array is not contiguous" "" { target "*-*-*" } 30 }
> +! { dg-error "not a proper array section" "" { target "*-*-*" } 30 }
>   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
> index 61250708197..f04d76d583a 100644
> --- a/libgomp/testsuite/libgomp.oacc-fortran/array-stride-dt-1.f90
> +++ b/libgomp/testsuite/libgomp.oacc-fortran/array-stride-dt-1.f90
> @@ -24,9 +24,8 @@ end do
>
>   b(1)%A(:,:) = 5
>
> -! TODO: Remove expected errors once this is supported.
> -!$acc update device(b(::2))  ! { dg-error "Stride should not be specified for array section in MAP clause" }
> -!$acc update device(b(1)%A(::3,::4))  ! { dg-error "Stride should not be specified for array section in MAP clause" }
> +!$acc update device(b(::2))
> +!$acc update device(b(1)%A(::3,::4))
>
>   do i=1,20
>     !$acc exit data copyout(b(i)%A)
-----------------
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/2] openacc: Strided array sections and components of derived-type arrays

[Julian Brown]

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

On Tue, 16 Feb 2021 11:09:17 +0100
Tobias Burnus <tobias@codesourcery.com> wrote:

> On 12.02.21 16:46, Julian Brown wrote:
> > This patch disallows selecting components of array sections in
> > update directives for OpenACC, as specified in OpenACC 3.0,
> > "2.14.4. Update Directive", "Restrictions":
> >
> >    "In Fortran, members of variables of derived type may appear,
> > including a subarray of a member. Members of subarrays of derived
> > type may not appear."
> >
> > The diagnostic for attempting to use the same construct on other
> > directives has also been improved.
> >
> > OK for mainline?  
> 
> LGTM.

Thanks. FYI I've committed this version with a merge conflict fixed &
new tests updated.

Julian

[-- Attachment #2: strides-dt-2.diff --]
[-- Type: text/x-patch, Size: 11763 bytes --]

commit 366cf1127a547ff77024a551abb01bb1a6e963cd
Author: Julian Brown <julian@codesourcery.com>
Date:   Wed Feb 10 11:18:13 2021 -0800

    openacc: Strided array sections and components of derived-type arrays
    
    This patch disallows selecting components of array sections in update
    directives for OpenACC, as specified in OpenACC 3.0, "2.14.4. Update
    Directive":
    
      In Fortran, members of variables of derived type may appear, including
      a subarray of a member. Members of subarrays of derived type may
      not appear.
    
    The diagnostic for attempting to use the same construct on other
    directives has also been improved.
    
    gcc/fortran/
            * openmp.c (resolve_omp_clauses): Disallow selecting components
            of arrays of derived type.
    
    gcc/testsuite/
            * gfortran.dg/goacc/array-with-dt-2.f90: Remove expected errors.
            * gfortran.dg/goacc/array-with-dt-6.f90: New test.
            * gfortran.dg/goacc/mapping-tests-2.f90: Update expected error.
            * gfortran.dg/goacc/ref_inquiry.f90: Update expected errors.
            * gfortran.dg/gomp/ref_inquiry.f90: Likewise.
    
    libgomp/
            * testsuite/libgomp.oacc-fortran/array-stride-dt-1.f90: Remove
            expected errors.

diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 1e541ebdafa..bf0179007be 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -5174,17 +5174,31 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 				 "are allowed on ORDERED directive at %L",
 				 &n->where);
 		  }
-		gfc_ref *array_ref = NULL;
+		gfc_ref *lastref = NULL, *lastslice = NULL;
 		bool resolved = false;
 		if (n->expr)
 		  {
-		    array_ref = n->expr->ref;
+		    lastref = n->expr->ref;
 		    resolved = gfc_resolve_expr (n->expr);
 
 		    /* Look through component refs to find last array
 		       reference.  */
 		    if (resolved)
 		      {
+			for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
+			  if (ref->type == REF_COMPONENT
+			      || ref->type == REF_SUBSTRING
+			      || ref->type == REF_INQUIRY)
+			    lastref = ref;
+			  else if (ref->type == REF_ARRAY)
+			    {
+			      for (int i = 0; i < ref->u.ar.dimen; i++)
+				if (ref->u.ar.dimen_type[i] == DIMEN_RANGE)
+				  lastslice = ref;
+
+			      lastref = ref;
+			    }
+
 			/* The "!$acc cache" directive allows rectangular
 			   subarrays to be specified, with some restrictions
 			   on the form of bounds (not implemented).
@@ -5192,53 +5206,51 @@ 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))
+			    && gfc_is_not_contiguous (n->expr)
+			    && !(lastslice
+				 && (lastslice->next
+				     || lastslice->type != REF_ARRAY)))
 			  gfc_error ("Array is not contiguous at %L",
 				     &n->where);
-
-			while (array_ref
-			       && (array_ref->type == REF_COMPONENT
-				   || (array_ref->type == REF_ARRAY
-				       && array_ref->next
-				       && (array_ref->next->type
-					   == REF_COMPONENT))))
-			  array_ref = array_ref->next;
 		      }
 		  }
-		if (array_ref
+		if (lastref
 		    || (n->expr
 			&& (!resolved || n->expr->expr_type != EXPR_VARIABLE)))
 		  {
-		    if (array_ref
-			&& (array_ref->type == REF_SUBSTRING
-			    || (array_ref->next
-				&& array_ref->next->type == REF_SUBSTRING)))
+		    if (!lastslice
+			&& lastref
+			&& lastref->type == REF_SUBSTRING)
 		      gfc_error ("Unexpected substring reference in %s clause "
 				 "at %L", name, &n->where);
-		    else if (array_ref && array_ref->type == REF_INQUIRY)
+		    else if (!lastslice
+			     && lastref
+			     && lastref->type == REF_INQUIRY)
 		      {
-			gcc_assert (array_ref->u.i == INQUIRY_RE
-				    || array_ref->u.i == INQUIRY_IM);
+			gcc_assert (lastref->u.i == INQUIRY_RE
+				    || lastref->u.i == INQUIRY_IM);
 			gfc_error ("Unexpected complex-parts designator "
 				   "reference in %s clause at %L",
 				   name, &n->where);
 		      }
 		    else if (!resolved
-			|| n->expr->expr_type != EXPR_VARIABLE
-			|| array_ref->next
-			|| array_ref->type != REF_ARRAY)
+			     || n->expr->expr_type != EXPR_VARIABLE
+			     || (lastslice
+				 && (lastslice->next
+				     || lastslice->type != REF_ARRAY)))
 		      gfc_error ("%qs in %s clause at %L is not a proper "
 				 "array section", n->sym->name, name,
 				 &n->where);
-		    else
+		    else if (lastslice)
 		      {
 			int i;
-			gfc_array_ref *ar = &array_ref->u.ar;
+			gfc_array_ref *ar = &lastslice->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
index e4a6f319772..807580d75a9 100644
--- a/gcc/testsuite/gfortran.dg/goacc/array-with-dt-2.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-2.f90
@@ -4,8 +4,7 @@ end type t
 
 type(t), allocatable :: b(:)
 
-! TODO: Remove expected errors when this is supported.
-!$acc update host(b(::2))  ! { dg-error "Stride should not be specified for array section in MAP clause" }
-!$acc update host(b(1)%A(::3,::4))  ! { dg-error "Stride should not be specified for array section in MAP clause" }
+!$acc update host(b(::2))
+!$acc update host(b(1)%A(::3,::4))
 end
 
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..adac8e3945e
--- /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)  ! { dg-error "not a proper array section" }
+!$acc update host(var(3)%b%j)  ! { dg-error "not a proper array section" }
+end
diff --git a/gcc/testsuite/gfortran.dg/goacc/mapping-tests-2.f90 b/gcc/testsuite/gfortran.dg/goacc/mapping-tests-2.f90
index 1372f6af53e..6b414fb8524 100644
--- a/gcc/testsuite/gfortran.dg/goacc/mapping-tests-2.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/mapping-tests-2.f90
@@ -24,9 +24,9 @@ subroutine foo
   ! Bad - we cannot do a strided access of 'x'
   ! No C/C++ equivalent
 !$acc enter data copyin(y(:)%i)
-! { dg-error "Array is not contiguous" "" { target "*-*-*" } 26 }
+! { dg-error "not a proper array section" "" { target "*-*-*" } 26 }
 
   ! Bad - again, a strided access
 !$acc enter data copyin(z(1)%cc(:)%i)
-! { dg-error "Array is not contiguous" "" { target "*-*-*" } 30 }
+! { dg-error "not a proper array section" "" { target "*-*-*" } 30 }
 end
diff --git a/gcc/testsuite/gfortran.dg/goacc/ref_inquiry.f90 b/gcc/testsuite/gfortran.dg/goacc/ref_inquiry.f90
index 69dd38e5197..7f3cc4ae274 100644
--- a/gcc/testsuite/gfortran.dg/goacc/ref_inquiry.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/ref_inquiry.f90
@@ -29,28 +29,20 @@ print *, is_contiguous(zz(:)%re)
 !$acc enter data copyin(z%re)    ! { dg-error "Unexpected complex-parts designator" }
 !$acc enter data copyin(z%im)    ! { dg-error "Unexpected complex-parts designator" }
 !$acc enter data copyin(zz%re)   ! { dg-error "not a proper array section" }
-                                 ! { dg-error "Array is not contiguous" "" { target *-*-* } .-1 }
 !$acc enter data copyin(zz%im)   ! { dg-error "not a proper array section" }
-                                 ! { dg-error "Array is not contiguous" "" { target *-*-* } .-1 }
 
 !$acc enter data copyin(x%z%re)  ! { dg-error "Unexpected complex-parts designator" }
 !$acc enter data copyin(x%z%im)  ! { dg-error "Unexpected complex-parts designator" }
 !$acc enter data copyin(x%zz%re) ! { dg-error "not a proper array section" }
-                                 ! { dg-error "Array is not contiguous" "" { target *-*-* } .-1 }
 !$acc enter data copyin(x%zz%im) ! { dg-error "not a proper array section" }
-                                 ! { dg-error "Array is not contiguous" "" { target *-*-* } .-1 }
 
 !$acc update self(z%re)         ! { dg-error "Unexpected complex-parts designator" }
 !$acc update self(z%im)         ! { dg-error "Unexpected complex-parts designator" }
 !$acc update self(zz%re)        ! { dg-error "not a proper array section" }
-                                ! { dg-error "Array is not contiguous" "" { target *-*-* } .-1 }
 !$acc update self(zz%im)        ! { dg-error "not a proper array section" }
-                                ! { dg-error "Array is not contiguous" "" { target *-*-* } .-1 }
 
 !$acc update self(x%z%re)       ! { dg-error "Unexpected complex-parts designator" }
 !$acc update self(x%z%im)       ! { dg-error "Unexpected complex-parts designator" }
 !$acc update self(x%zz%re)      ! { dg-error "is not a proper array section" }
-                                ! { dg-error "Array is not contiguous" "" { target *-*-* } .-1 }
 !$acc update self(x%zz%im)      ! { dg-error "is not a proper array section" }
-                                ! { dg-error "Array is not contiguous" "" { target *-*-* } .-1 }
 end
diff --git a/gcc/testsuite/gfortran.dg/gomp/ref_inquiry.f90 b/gcc/testsuite/gfortran.dg/gomp/ref_inquiry.f90
index 37461040560..610d9ec0b95 100644
--- a/gcc/testsuite/gfortran.dg/gomp/ref_inquiry.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/ref_inquiry.f90
@@ -25,15 +25,11 @@ print *, is_contiguous(zz(:)%re)
 !$omp target enter data map(to: z%re)    ! { dg-error "Unexpected complex-parts designator" }
 !$omp target enter data map(to: z%im)    ! { dg-error "Unexpected complex-parts designator" }
 !$omp target enter data map(to: zz%re)   ! { dg-error "not a proper array section" }
-                                         ! { dg-error "Array is not contiguous" "" { target *-*-* } .-1 }
 !$omp target enter data map(to: zz%im)   ! { dg-error "not a proper array section" }
-                                         ! { dg-error "Array is not contiguous" "" { target *-*-* } .-1 }
 
 !$omp target enter data map(to: x%z%re)  ! { dg-error "Unexpected complex-parts designator" }
 !$omp target enter data map(to: x%z%im)  ! { dg-error "Unexpected complex-parts designator" }
 !$omp target enter data map(to: x%zz%re) ! { dg-error "not a proper array section" }
-                                         ! { dg-error "Array is not contiguous" "" { target *-*-* } .-1 }
 !$omp target enter data map(to: x%zz%im) ! { dg-error "not a proper array section" }
-                                         ! { dg-error "Array is not contiguous" "" { target *-*-* } .-1 }
 
 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
index 61250708197..f04d76d583a 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/array-stride-dt-1.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/array-stride-dt-1.f90
@@ -24,9 +24,8 @@ end do
 
 b(1)%A(:,:) = 5
 
-! TODO: Remove expected errors once this is supported.
-!$acc update device(b(::2))  ! { dg-error "Stride should not be specified for array section in MAP clause" }
-!$acc update device(b(1)%A(::3,::4))  ! { dg-error "Stride should not be specified for array section in MAP clause" }
+!$acc update device(b(::2))
+!$acc update device(b(1)%A(::3,::4))
 
 do i=1,20
   !$acc exit data copyout(b(i)%A)