public inbox for fortran@gcc.gnu.org
 help / color / mirror / Atom feed
* [PATCH 5/7] [og10] Fortran: %re/%im fixes for OpenMP/OpenACC + gfc_is_simplify_contiguous
@ 2021-02-24 21:58 Julian Brown
  2021-02-24 21:58 ` [PATCH 6/7] [og10] openacc: Fix lowering for derived-type mappings through array elements Julian Brown
  2021-02-24 21:58 ` [PATCH 7/7] [og10] openacc: Strided array sections and components of derived-type arrays Julian Brown
  0 siblings, 2 replies; 3+ messages in thread
From: Julian Brown @ 2021-02-24 21:58 UTC (permalink / raw)
  To: gcc-patches; +Cc: fortran, Tobias Burnus

From: Tobias Burnus <tobias@codesourcery.com>

gcc/fortran/ChangeLog:

	* expr.c (gfc_is_simplify_contiguous): Handle REF_INQUIRY, i.e.
	%im and %re which are EXPR_VARIABLE.
	* openmp.c (resolve_omp_clauses): Diagnose %re/%im explicitly.

gcc/testsuite/ChangeLog:

	* gfortran.dg/goacc/ref_inquiry.f90: New test.
	* gfortran.dg/gomp/ref_inquiry.f90: New test.

(cherry picked from commit 799478b8914c438f7a33eb319efbae69c81f2111)
---
 gcc/fortran/ChangeLog.omp                     |  8 +++
 gcc/fortran/expr.c                            |  2 +
 gcc/fortran/openmp.c                          |  8 +++
 gcc/testsuite/ChangeLog.omp                   |  7 +++
 .../gfortran.dg/goacc/ref_inquiry.f90         | 56 +++++++++++++++++++
 .../gfortran.dg/gomp/ref_inquiry.f90          | 39 +++++++++++++
 6 files changed, 120 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/ref_inquiry.f90
 create mode 100644 gcc/testsuite/gfortran.dg/gomp/ref_inquiry.f90

diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index 09c2bb855c88..f99a11316f52 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,11 @@
+2021-02-24  Tobias Burnus  <tobias@codesourcery.com>
+
+	Backport from mainline
+
+	* expr.c (gfc_is_simplify_contiguous): Handle REF_INQUIRY, i.e.
+	%im and %re which are EXPR_VARIABLE.
+	* openmp.c (resolve_omp_clauses): Diagnose %re/%im explicitly.
+
 2021-02-24  Tobias Burnus  <tobias@codesourcery.com>
 
 	Backport from mainline
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 569f4d9bf066..6cda947cd568 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -5837,6 +5837,8 @@ gfc_is_simply_contiguous (gfc_expr *expr, bool strict, bool permit_element)
 	part_ref  = ref;
       else if (ref->type == REF_SUBSTRING)
 	return false;
+      else if (ref->type == REF_INQUIRY)
+	return false;
       else if (ref->u.ar.type != AR_ELEMENT)
 	ar = &ref->u.ar;
     }
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index a7592f0545d9..8d77f9e73510 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -4984,6 +4984,14 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 				&& array_ref->next->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)
+		      {
+			gcc_assert (array_ref->u.i == INQUIRY_RE
+				    || array_ref->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
diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index d012e9e75b4e..257981890982 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,10 @@
+2021-02-24  Tobias Burnus  <tobias@codesourcery.com>
+
+	Backport from mainline
+
+	* gfortran.dg/goacc/ref_inquiry.f90: New test.
+	* gfortran.dg/gomp/ref_inquiry.f90: New test.
+
 2021-02-24  Tobias Burnus  <tobias@codesourcery.com>
 
 	Backport from mainline
diff --git a/gcc/testsuite/gfortran.dg/goacc/ref_inquiry.f90 b/gcc/testsuite/gfortran.dg/goacc/ref_inquiry.f90
new file mode 100644
index 000000000000..69dd38e51974
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/ref_inquiry.f90
@@ -0,0 +1,56 @@
+! Check for <var>%re, ...%im, ...%kind, ...%len
+! Cf. also OpenMP's ../gomp/ref_inquiry.f90
+! Cf. OpenACC spec issue 346
+! 
+implicit none
+type t
+  integer :: i
+  character :: c
+  complex :: z
+  complex :: zz(5)
+end type t
+
+integer :: i
+character(kind=4, len=5) :: c
+complex :: z, zz(5)
+type(t) :: x
+
+print *, is_contiguous(zz(:)%re)
+
+! inquiry function; expr_type != EXPR_VARIABLE:
+!$acc enter data copyin(i%kind, c%len)     ! { dg-error "not a proper array section" }
+!$acc enter data copyin(x%i%kind)          ! { dg-error "not a proper array section" }
+!$acc enter data copyin(x%c%len)           ! { dg-error "not a proper array section" }
+!$acc update self(i%kind, c%len)           ! { dg-error "not a proper array section" }
+!$acc update self(x%i%kind)                ! { dg-error "not a proper array section" }
+!$acc update self(x%c%len)                 ! { dg-error "not a proper array section" }
+
+! EXPR_VARIABLE
+!$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
new file mode 100644
index 000000000000..374610405601
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/ref_inquiry.f90
@@ -0,0 +1,39 @@
+! Check for <var>%re, ...%im, ...%kind, ...%len
+! Cf. also OpenACC's ../goacc/ref_inquiry.f90
+! Cf. also OpenMP spec issue 2661
+implicit none
+type t
+  integer :: i
+  character :: c
+  complex :: z
+  complex :: zz(5)
+end type t
+
+integer :: i
+character(kind=4, len=5) :: c
+complex :: z, zz(5)
+type(t) :: x
+
+print *, is_contiguous(zz(:)%re)
+
+! inquiry function; expr_type != EXPR_VARIABLE:
+!$omp target enter data map(to: i%kind, c%len)     ! { dg-error "not a proper array section" }
+!$omp target enter data map(to: x%i%kind)          ! { dg-error "not a proper array section" }
+!$omp target enter data map(to: x%c%len)           ! { dg-error "not a proper array section" }
+
+! EXPR_VARIABLE
+!$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
-- 
2.29.2


^ permalink raw reply	[flat|nested] 3+ messages in thread

* [PATCH 6/7] [og10] openacc: Fix lowering for derived-type mappings through array elements
  2021-02-24 21:58 [PATCH 5/7] [og10] Fortran: %re/%im fixes for OpenMP/OpenACC + gfc_is_simplify_contiguous Julian Brown
@ 2021-02-24 21:58 ` Julian Brown
  2021-02-24 21:58 ` [PATCH 7/7] [og10] openacc: Strided array sections and components of derived-type arrays Julian Brown
  1 sibling, 0 replies; 3+ messages in thread
From: Julian Brown @ 2021-02-24 21:58 UTC (permalink / raw)
  To: gcc-patches; +Cc: fortran, Tobias Burnus

This patch fixes lowering of derived-type mappings which select elements
of arrays of derived types, and similar. These would previously lead
to ICEs.

With this change, OpenACC directives can pass through constructs that
are no longer recognized by the gimplifier, hence alterations are needed
there also.

gcc/fortran/
	* trans-openmp.c (gfc_trans_omp_clauses): Handle element selection
	for arrays of derived types.

gcc/
	* gimplify.c (gimplify_scan_omp_clauses): Handle ATTACH_DETACH
	for non-decls.

gcc/testsuite/
	* gfortran.dg/goacc/array-with-dt-1.f90: New test.
	* gfortran.dg/goacc/array-with-dt-3.f90: Likewise.
	* gfortran.dg/goacc/array-with-dt-4.f90: Likewise.
	* gfortran.dg/goacc/array-with-dt-5.f90: Likewise.
	* gfortran.dg/goacc/derived-chartypes-1.f90: Re-enable test.
	* gfortran.dg/goacc/derived-chartypes-2.f90: Likewise.
	* gfortran.dg/goacc/derived-classtypes-1.f95: Uncomment
	previously-broken directives.

libgomp/
	* testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90: New test.
	* testsuite/libgomp.oacc-fortran/update-dt-array.f90: Likewise.

(cherry picked from commit d28f3da11d8c0aed9b746689d723022a9b5ec04c)
---
 gcc/ChangeLog.omp                             |   7 +
 gcc/fortran/ChangeLog.omp                     |   7 +
 gcc/fortran/trans-openmp.c                    | 192 ++++++++++--------
 gcc/gimplify.c                                |  12 ++
 gcc/testsuite/ChangeLog.omp                   |  13 ++
 .../gfortran.dg/goacc/array-with-dt-1.f90     |  11 +
 .../gfortran.dg/goacc/array-with-dt-3.f90     |  14 ++
 .../gfortran.dg/goacc/array-with-dt-4.f90     |  18 ++
 .../gfortran.dg/goacc/array-with-dt-5.f90     |  12 ++
 .../gfortran.dg/goacc/derived-chartypes-1.f90 |   3 -
 .../gfortran.dg/goacc/derived-chartypes-2.f90 |   3 -
 .../goacc/derived-classtypes-1.f95            |   8 +-
 libgomp/ChangeLog.omp                         |   7 +
 .../derivedtypes-arrays-1.f90                 | 109 ++++++++++
 .../libgomp.oacc-fortran/update-dt-array.f90  |  53 +++++
 15 files changed, 378 insertions(+), 91 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/array-with-dt-1.f90
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/array-with-dt-3.f90
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/array-with-dt-4.f90
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/array-with-dt-5.f90
 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90
 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/update-dt-array.f90

diff --git a/gcc/ChangeLog.omp b/gcc/ChangeLog.omp
index ba959fb37a4f..a59c25b79763 100644
--- a/gcc/ChangeLog.omp
+++ b/gcc/ChangeLog.omp
@@ -1,3 +1,10 @@
+2021-02-24  Julian Brown  <julian@codesourcery.com>
+
+	Backport from mainline
+
+	* gimplify.c (gimplify_scan_omp_clauses): Handle ATTACH_DETACH
+	for non-decls.
+
 2021-02-16  Tobias Burnus  <tobias@codesourcery.com>
 
 	* doc/invoke.texi (nvptx's -misa): Update default to sm_35.
diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index f99a11316f52..007855075563 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,10 @@
+2021-02-24  Julian Brown  <julian@codesourcery.com>
+
+	Backport from mainline
+
+	* trans-openmp.c (gfc_trans_omp_clauses): Handle element selection
+	for arrays of derived types.
+
 2021-02-24  Tobias Burnus  <tobias@codesourcery.com>
 
 	Backport from mainline
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index d0e299b02142..e3df4bbf84ec 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -2660,6 +2660,32 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 	      tree decl = gfc_trans_omp_variable (n->sym, false);
 	      if (DECL_P (decl))
 		TREE_ADDRESSABLE (decl) = 1;
+
+	      gfc_ref *lastref = NULL;
+
+	      if (n->expr)
+		for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
+		  if (ref->type == REF_COMPONENT || ref->type == REF_ARRAY)
+		    lastref = ref;
+
+	      bool allocatable = false, pointer = false;
+
+	      if (lastref && lastref->type == REF_COMPONENT)
+		{
+		  gfc_component *c = lastref->u.c.component;
+
+		  if (c->ts.type == BT_CLASS)
+		    {
+		      pointer = CLASS_DATA (c)->attr.class_pointer;
+		      allocatable = CLASS_DATA (c)->attr.allocatable;
+		    }
+		  else
+		    {
+		      pointer = c->attr.pointer;
+		      allocatable = c->attr.allocatable;
+		    }
+		}
+
 	      if (n->expr == NULL
 		  || (n->expr->ref->type == REF_ARRAY
 		      && n->expr->ref->u.ar.type == AR_FULL))
@@ -2887,74 +2913,79 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		}
 	      else if (n->expr
 		       && n->expr->expr_type == EXPR_VARIABLE
-		       && n->expr->ref->type == REF_COMPONENT)
+		       && n->expr->ref->type == REF_ARRAY
+		       && !n->expr->ref->next)
 		{
-		  gfc_ref *lastcomp;
-
-		  for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
-		    if (ref->type == REF_COMPONENT)
-		      lastcomp = ref;
-
-		  symbol_attribute sym_attr;
-
-		  if (lastcomp->u.c.component->ts.type == BT_CLASS)
-		    sym_attr = CLASS_DATA (lastcomp->u.c.component)->attr;
-		  else
-		    sym_attr = lastcomp->u.c.component->attr;
-
+		  /* An array element or array section which is not part of a
+		     derived type, etc.  */
+		  bool element = n->expr->ref->u.ar.type == AR_ELEMENT;
+		  gfc_trans_omp_array_section (block, n, decl, element,
+					       GOMP_MAP_POINTER, node, node2,
+					       node3, node4);
+		}
+	      else if (n->expr
+		       && n->expr->expr_type == EXPR_VARIABLE
+		       && (n->expr->ref->type == REF_COMPONENT
+			   || n->expr->ref->type == REF_ARRAY)
+		       && lastref
+		       && lastref->type == REF_COMPONENT
+		       && lastref->u.c.component->ts.type != BT_CLASS
+		       && lastref->u.c.component->ts.type != BT_DERIVED
+		       && !lastref->u.c.component->attr.dimension)
+		{
+		  /* Derived type access with last component being a scalar.  */
 		  gfc_init_se (&se, NULL);
 
-		  if (!sym_attr.dimension
-		      && lastcomp->u.c.component->ts.type != BT_CLASS
-		      && lastcomp->u.c.component->ts.type != BT_DERIVED)
+		  gfc_conv_expr (&se, n->expr);
+		  gfc_add_block_to_block (block, &se.pre);
+		  /* For BT_CHARACTER a pointer is returned.  */
+		  OMP_CLAUSE_DECL (node)
+		    = POINTER_TYPE_P (TREE_TYPE (se.expr))
+		      ? build_fold_indirect_ref (se.expr) : se.expr;
+		  gfc_add_block_to_block (block, &se.post);
+		  if (pointer || allocatable)
 		    {
-		      /* Last component is a scalar.  */
-		      gfc_conv_expr (&se, n->expr);
-		      gfc_add_block_to_block (block, &se.pre);
-		      /* For BT_CHARACTER a pointer is returned.  */
-		      OMP_CLAUSE_DECL (node)
+		      node2 = build_omp_clause (input_location,
+						OMP_CLAUSE_MAP);
+		      gomp_map_kind kind
+			= (openacc ? GOMP_MAP_ATTACH_DETACH
+				   : GOMP_MAP_ALWAYS_POINTER);
+		      OMP_CLAUSE_SET_MAP_KIND (node2, kind);
+		      OMP_CLAUSE_DECL (node2)
 			= POINTER_TYPE_P (TREE_TYPE (se.expr))
-			  ? build_fold_indirect_ref (se.expr) : se.expr;
-		      gfc_add_block_to_block (block, &se.post);
-		      if (sym_attr.pointer || sym_attr.allocatable)
+			  ? se.expr
+			  : gfc_build_addr_expr (NULL, se.expr);
+		      OMP_CLAUSE_SIZE (node2) = size_int (0);
+		      if (!openacc
+			  && n->expr->ts.type == BT_CHARACTER
+			  && n->expr->ts.deferred)
 			{
-			  node2 = build_omp_clause (input_location,
+			  gcc_assert (se.string_length);
+			  tree tmp
+			    = gfc_get_char_type (n->expr->ts.kind);
+			  OMP_CLAUSE_SIZE (node)
+			    = fold_build2 (MULT_EXPR, size_type_node,
+					   fold_convert (size_type_node,
+					       se.string_length),
+					   TYPE_SIZE_UNIT (tmp));
+			  node3 = build_omp_clause (input_location,
 						    OMP_CLAUSE_MAP);
-			  OMP_CLAUSE_SET_MAP_KIND (node2,
-						   openacc
-						   ? GOMP_MAP_ATTACH_DETACH
-						   : GOMP_MAP_ALWAYS_POINTER);
-			  OMP_CLAUSE_DECL (node2)
-			    = POINTER_TYPE_P (TREE_TYPE (se.expr))
-			      ? se.expr :  gfc_build_addr_expr (NULL, se.expr);
-			  OMP_CLAUSE_SIZE (node2) = size_int (0);
-			  if (!openacc
-			      && n->expr->ts.type == BT_CHARACTER
-			      && n->expr->ts.deferred)
-			    {
-			      gcc_assert (se.string_length);
-			      tree tmp = gfc_get_char_type (n->expr->ts.kind);
-			      OMP_CLAUSE_SIZE (node)
-				= fold_build2 (MULT_EXPR, size_type_node,
-					       fold_convert (size_type_node,
-							     se.string_length),
-					       TYPE_SIZE_UNIT (tmp));
-			      node3 = build_omp_clause (input_location,
-							OMP_CLAUSE_MAP);
-			      OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_TO);
-			      OMP_CLAUSE_DECL (node3) = se.string_length;
-			      OMP_CLAUSE_SIZE (node3)
-				= TYPE_SIZE_UNIT (gfc_charlen_type_node);
-			    }
+			  OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_TO);
+			  OMP_CLAUSE_DECL (node3) = se.string_length;
+			  OMP_CLAUSE_SIZE (node3)
+			    = TYPE_SIZE_UNIT (gfc_charlen_type_node);
 			}
-		      goto finalize_map_clause;
 		    }
-
+		}
+	      else if (n->expr
+		       && n->expr->expr_type == EXPR_VARIABLE
+		       && (n->expr->ref->type == REF_COMPONENT
+			   || n->expr->ref->type == REF_ARRAY))
+		{
+		  gfc_init_se (&se, NULL);
 		  se.expr = gfc_maybe_dereference_var (n->sym, decl);
 
-		  for (gfc_ref *ref = n->expr->ref;
-		       ref && ref != lastcomp->next;
-		       ref = ref->next)
+		  for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
 		    {
 		      if (ref->type == REF_COMPONENT)
 			{
@@ -2963,24 +2994,30 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 
 			  gfc_conv_component_ref (&se, ref);
 			}
+		      else if (ref->type == REF_ARRAY)
+			{
+			  if (ref->u.ar.type == AR_ELEMENT && ref->next)
+			    gfc_conv_array_ref (&se, &ref->u.ar, n->expr,
+						&n->expr->where);
+			  else
+			    gcc_assert (!ref->next);
+			}
 		      else
-			sorry ("unhandled derived-type component");
+			sorry ("unhandled expression type");
 		    }
 
 		  tree inner = se.expr;
 
 		  /* Last component is a derived type or class pointer.  */
-		  if (lastcomp->u.c.component->ts.type == BT_DERIVED
-		      || lastcomp->u.c.component->ts.type == BT_CLASS)
+		  if (lastref->type == REF_COMPONENT
+		      && (lastref->u.c.component->ts.type == BT_DERIVED
+			  || lastref->u.c.component->ts.type == BT_CLASS))
 		    {
-		      bool pointer
-			= (lastcomp->u.c.component->ts.type == BT_CLASS
-			   ? sym_attr.class_pointer : sym_attr.pointer);
-		      if (pointer || (openacc && sym_attr.allocatable))
+		      if (pointer || (openacc && allocatable))
 			{
 			  tree data, size;
 
-			  if (lastcomp->u.c.component->ts.type == BT_CLASS)
+			  if (lastref->u.c.component->ts.type == BT_CLASS)
 			    {
 			      data = gfc_class_data_get (inner);
 			      gcc_assert (POINTER_TYPE_P (TREE_TYPE (data)));
@@ -3011,9 +3048,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			    = TYPE_SIZE_UNIT (TREE_TYPE (inner));
 			}
 		    }
-		  else if (lastcomp->next
-			   && lastcomp->next->type == REF_ARRAY
-			   && lastcomp->next->u.ar.type == AR_FULL)
+		  else if (lastref->type == REF_ARRAY
+			   && lastref->u.ar.type == AR_FULL)
 		    {
 		      /* Just pass the (auto-dereferenced) decl through for
 			 bare attach and detach clauses.  */
@@ -3107,27 +3143,21 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		      else
 			OMP_CLAUSE_DECL (node) = inner;
 		    }
-		  else  /* An array element or section.  */
+		  else if (lastref->type == REF_ARRAY)
 		    {
-		      bool element
-			= (lastcomp->next
-			   && lastcomp->next->type == REF_ARRAY
-			   && lastcomp->next->u.ar.type == AR_ELEMENT);
-
+		      /* An array element or section.  */
+		      bool element = lastref->u.ar.type == AR_ELEMENT;
 		      gomp_map_kind kind = (openacc ? GOMP_MAP_ATTACH_DETACH
 						    : GOMP_MAP_ALWAYS_POINTER);
 		      gfc_trans_omp_array_section (block, n, inner, element,
 						   kind, node, node2, node3,
 						   node4);
 		    }
+		  else
+		    gcc_unreachable ();
 		}
-	      else  /* An array element or array section.  */
-		{
-		  bool element = n->expr->ref->u.ar.type == AR_ELEMENT;
-		  gfc_trans_omp_array_section (block, n, decl, element,
-					       GOMP_MAP_POINTER, node, node2,
-					       node3, node4);
-		}
+	      else
+		sorry ("unhandled expression");
 
 	      finalize_map_clause:
 
diff --git a/gcc/gimplify.c b/gcc/gimplify.c
index 4e99ee2d38af..bf2129c79580 100644
--- a/gcc/gimplify.c
+++ b/gcc/gimplify.c
@@ -9440,6 +9440,18 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
 			}
 		    }
 		}
+	      else if ((code == OACC_ENTER_DATA
+			|| code == OACC_EXIT_DATA
+			|| code == OACC_DATA
+			|| code == OACC_PARALLEL
+			|| code == OACC_KERNELS
+			|| code == OACC_SERIAL)
+		       && OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_ATTACH_DETACH)
+		{
+		  gomp_map_kind k = (code == OACC_EXIT_DATA
+				     ? GOMP_MAP_DETACH : GOMP_MAP_ATTACH);
+		  OMP_CLAUSE_SET_MAP_KIND (c, k);
+		}
 
 	      if (gimplify_expr (pd, pre_p, NULL, is_gimple_lvalue, fb_lvalue)
 		  == GS_ERROR)
diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index 257981890982..98032a72d4b9 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,16 @@
+2021-02-24  Julian Brown  <julian@codesourcery.com>
+
+	Backport from mainline
+
+	* gfortran.dg/goacc/array-with-dt-1.f90: New test.
+	* gfortran.dg/goacc/array-with-dt-3.f90: Likewise.
+	* gfortran.dg/goacc/array-with-dt-4.f90: Likewise.
+	* gfortran.dg/goacc/array-with-dt-5.f90: Likewise.
+	* gfortran.dg/goacc/derived-chartypes-1.f90: Re-enable test.
+	* gfortran.dg/goacc/derived-chartypes-2.f90: Likewise.
+	* gfortran.dg/goacc/derived-classtypes-1.f95: Uncomment
+	previously-broken directives.
+
 2021-02-24  Tobias Burnus  <tobias@codesourcery.com>
 
 	Backport from mainline
diff --git a/gcc/testsuite/gfortran.dg/goacc/array-with-dt-1.f90 b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-1.f90
new file mode 100644
index 000000000000..4a3ff0ef3a75
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-1.f90
@@ -0,0 +1,11 @@
+type t
+   integer, allocatable :: A(:,:)
+end type t
+
+type(t), allocatable :: b(:)
+
+!$acc update host(b)
+!$acc update host(b(:))
+!$acc update host(b(1)%A)
+!$acc update host(b(1)%A(:,:))
+end
diff --git a/gcc/testsuite/gfortran.dg/goacc/array-with-dt-3.f90 b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-3.f90
new file mode 100644
index 000000000000..dcb63657f2bb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-3.f90
@@ -0,0 +1,14 @@
+type t2
+   integer :: A(200,200)
+end type t2
+type t
+   integer, allocatable :: A(:,:)
+end type t
+
+type(t2),allocatable :: c(:)
+type(t), allocatable :: d(:)
+
+!$acc exit data delete(c(1)%A)
+!$acc exit data delete(d(1)%A)
+
+end
diff --git a/gcc/testsuite/gfortran.dg/goacc/array-with-dt-4.f90 b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-4.f90
new file mode 100644
index 000000000000..637d5f57e1c1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-4.f90
@@ -0,0 +1,18 @@
+type t4
+  integer, allocatable :: quux(:)
+end type t4
+type t3
+  type(t4), pointer :: qux(:)
+end type t3
+type t2
+  type(t3), allocatable :: bar(:)
+end type t2
+type t
+  type(t2), allocatable :: foo(:)
+end type t
+
+type(t), allocatable :: c(:)
+
+!$acc enter data copyin(c(5)%foo(4)%bar(3)%qux(2)%quux(:))
+!$acc exit data delete(c(5)%foo(4)%bar(3)%qux(2)%quux(:))
+end
diff --git a/gcc/testsuite/gfortran.dg/goacc/array-with-dt-5.f90 b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-5.f90
new file mode 100644
index 000000000000..900587b7eaf6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-5.f90
@@ -0,0 +1,12 @@
+type t2
+  integer :: bar
+end type t2
+type t
+  type(t2), pointer :: foo
+end type t
+
+type(t) :: c
+
+!$acc enter data copyin(c%foo)
+
+end
diff --git a/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-1.f90 b/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-1.f90
index f7aafbfc036f..e4d360e1262b 100644
--- a/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-1.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-1.f90
@@ -1,6 +1,3 @@
-! This currently ICEs. Avoid that.
-! { dg-skip-if "PR98979" { *-*-* } }
-
 type :: type1
   character(len=35) :: a
 end type type1
diff --git a/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-2.f90 b/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-2.f90
index e22fc679df2b..cca6443e7fcf 100644
--- a/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-2.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/derived-chartypes-2.f90
@@ -1,6 +1,3 @@
-! This currently ICEs. Avoid that.
-! { dg-skip-if "PR98979" { *-*-* } }
-
 type :: type1
   character(len=35,kind=4) :: a
 end type type1
diff --git a/gcc/testsuite/gfortran.dg/goacc/derived-classtypes-1.f95 b/gcc/testsuite/gfortran.dg/goacc/derived-classtypes-1.f95
index e6cf09c6d3c1..85a2e1d373d0 100644
--- a/gcc/testsuite/gfortran.dg/goacc/derived-classtypes-1.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/derived-classtypes-1.f95
@@ -71,7 +71,7 @@ class(type7), allocatable :: acshiela
 !$acc enter data copyin(bar)
 !$acc enter data copyin(bar%b)
 !$acc enter data copyin(qux)
-!!$acc enter data copyin(qux%c)
+!$acc enter data copyin(qux%c)
 !$acc enter data copyin(quux)
 !$acc enter data copyin(quux%d)
 !$acc enter data copyin(fred)
@@ -86,7 +86,7 @@ class(type7), allocatable :: acshiela
 !$acc enter data copyin(pbar)
 !$acc enter data copyin(pbar%b)
 !$acc enter data copyin(pqux)
-!!$acc enter data copyin(pqux%c)
+!$acc enter data copyin(pqux%c)
 !$acc enter data copyin(pquux)
 !$acc enter data copyin(pquux%d)
 !$acc enter data copyin(pfred)
@@ -101,7 +101,7 @@ class(type7), allocatable :: acshiela
 !$acc enter data copyin(cbar)
 !$acc enter data copyin(cbar%b)
 !$acc enter data copyin(cqux)
-!!$acc enter data copyin(cqux%c)
+!$acc enter data copyin(cqux%c)
 !$acc enter data copyin(cquux)
 !$acc enter data copyin(cquux%d)
 !$acc enter data copyin(cfred)
@@ -116,7 +116,7 @@ class(type7), allocatable :: acshiela
 !$acc enter data copyin(acbar)
 !$acc enter data copyin(acbar%b)
 !$acc enter data copyin(acqux)
-!!$acc enter data copyin(acqux%c)
+!$acc enter data copyin(acqux%c)
 !$acc enter data copyin(acquux)
 !$acc enter data copyin(acquux%d)
 !$acc enter data copyin(acfred)
diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp
index db6ac79fe123..0f862d1b573a 100644
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/ChangeLog.omp
@@ -1,3 +1,10 @@
+2021-02-24  Julian Brown  <julian@codesourcery.com>
+
+	Backport from mainline
+
+	* testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90: New test.
+	* testsuite/libgomp.oacc-fortran/update-dt-array.f90: Likewise.
+
 2021-02-24  Julian Brown  <julian@codesourcery.com>
 
 	Backport from mainline
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90
new file mode 100644
index 000000000000..644ad1f6b2fc
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90
@@ -0,0 +1,109 @@
+! { dg-do run }
+
+type type1
+  integer, allocatable :: arr1(:,:)
+end type type1
+
+type type2
+  type(type1) :: t1
+end type type2
+
+type type3
+  type(type2) :: t2(20)
+end type type3
+
+type type4
+  type(type3), allocatable :: t3(:)
+end type type4
+
+integer :: i, j, k
+
+type(type4), allocatable :: var1(:)
+type(type4) :: var2
+type(type3) :: var3
+
+allocate(var1(1:20))
+do i=1,20
+  allocate(var1(i)%t3(1:20))
+  do j=1,20
+    do k=1,20
+      allocate(var1(i)%t3(j)%t2(k)%t1%arr1(1:20,1:20))
+    end do
+  end do
+end do
+
+allocate(var2%t3(1:20))
+do i=1,20
+  do j=1,20
+    allocate(var2%t3(i)%t2(j)%t1%arr1(1:20,1:20))
+  end do
+end do
+
+do i=1,20
+  do j=1,20
+    do k=1,20
+      var1(i)%t3(j)%t2(k)%t1%arr1(:,:) = 0
+    end do
+    var2%t3(i)%t2(j)%t1%arr1(:,:) = 0
+  end do
+end do
+
+!$acc enter data copyin(var2%t3(4)%t2(3)%t1%arr1(:,:))
+!$acc enter data copyin(var1(5)%t3(4)%t2(3)%t1%arr1(:,:))
+
+var2%t3(4)%t2(3)%t1%arr1(:,:) = 5
+var1(5)%t3(4)%t2(3)%t1%arr1(:,:) = 4
+
+!$acc update device(var2%t3(4)%t2(3)%t1%arr1)
+!$acc update device(var1(5)%t3(4)%t2(3)%t1%arr1)
+
+!$acc exit data copyout(var1(5)%t3(4)%t2(3)%t1%arr1(:,:))
+!$acc exit data copyout(var2%t3(4)%t2(3)%t1%arr1(:,:))
+
+do i=1,20
+  do j=1,20
+    do k=1,20
+      if (i.eq.5 .and. j.eq.4 .and. k.eq.3) then
+        if (any(var1(i)%t3(j)%t2(k)%t1%arr1 .ne. 4)) stop 1
+      else
+        if (any(var1(i)%t3(j)%t2(k)%t1%arr1 .ne. 0)) stop 2
+      end if
+    end do
+    if (i.eq.4 .and. j.eq.3) then
+      if (any(var2%t3(i)%t2(j)%t1%arr1 .ne. 5)) stop 3
+    else
+      if (any(var2%t3(i)%t2(j)%t1%arr1 .ne. 0)) stop 4
+    end if
+  end do
+end do
+
+do i=1,20
+  allocate(var3%t2(i)%t1%arr1(1:20, 1:20))
+  var3%t2(i)%t1%arr1(:,:) = 0
+end do
+
+!$acc enter data copyin(var3)
+!$acc enter data copyin(var3%t2(:))
+!$acc enter data copyin(var3%t2(5)%t1)
+!$acc data copyin(var3%t2(5)%t1%arr1)
+
+!$acc serial present(var3%t2(5)%t1%arr1)
+var3%t2(5)%t1%arr1(:,:) = 6
+!$acc end serial
+
+!$acc update host(var3%t2(5)%t1%arr1)
+
+!$acc end data
+!$acc exit data delete(var3%t2(5)%t1)
+!$acc exit data delete(var3%t2)
+!$acc exit data delete(var3)
+
+do i=1,20
+  if (i.eq.5) then
+    if (any(var3%t2(i)%t1%arr1.ne.6)) stop 5
+  else
+    if (any(var3%t2(i)%t1%arr1.ne.0)) stop 6
+  end if
+end do
+
+end
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/update-dt-array.f90 b/libgomp/testsuite/libgomp.oacc-fortran/update-dt-array.f90
new file mode 100644
index 000000000000..d796eddceda5
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/update-dt-array.f90
@@ -0,0 +1,53 @@
+! { dg-do run }
+
+program myprog
+
+  type mytype
+    integer, allocatable :: myarr(:,:)
+  end type mytype
+  integer :: i
+
+  type(mytype), allocatable :: typearr(:)
+
+  allocate(typearr(1:100))
+
+  do i=1,100
+    allocate(typearr(i)%myarr(1:100,1:100))
+  end do
+
+  do i=1,100
+    typearr(i)%myarr(:,:) = 0
+  end do
+
+  !$acc enter data copyin(typearr)
+
+  do i=1,100
+    !$acc enter data copyin(typearr(i)%myarr)
+  end do
+
+  i=33
+  typearr(i)%myarr(:,:) = 50
+
+  !$acc update device(typearr(i)%myarr(:,:))
+
+  do i=1,100
+    !$acc exit data copyout(typearr(i)%myarr)
+  end do
+
+  !$acc exit data delete(typearr)
+
+  do i=1,100
+    if (i.eq.33) then
+      if (any(typearr(i)%myarr.ne.50)) stop 1
+    else
+      if (any(typearr(i)%myarr.ne.0)) stop 2
+    end if
+  end do
+
+  do i=1,100
+    deallocate(typearr(i)%myarr)
+  end do
+
+  deallocate(typearr)
+
+end program myprog
-- 
2.29.2


^ permalink raw reply	[flat|nested] 3+ messages in thread

* [PATCH 7/7] [og10] openacc: Strided array sections and components of derived-type arrays
  2021-02-24 21:58 [PATCH 5/7] [og10] Fortran: %re/%im fixes for OpenMP/OpenACC + gfc_is_simplify_contiguous Julian Brown
  2021-02-24 21:58 ` [PATCH 6/7] [og10] openacc: Fix lowering for derived-type mappings through array elements Julian Brown
@ 2021-02-24 21:58 ` Julian Brown
  1 sibling, 0 replies; 3+ messages in thread
From: Julian Brown @ 2021-02-24 21:58 UTC (permalink / raw)
  To: gcc-patches; +Cc: fortran, Tobias Burnus

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.

(cherry picked from commit 366cf1127a547ff77024a551abb01bb1a6e963cd)
---
 gcc/fortran/ChangeLog.omp                     |  7 ++
 gcc/fortran/openmp.c                          | 64 +++++++++++--------
 gcc/testsuite/ChangeLog.omp                   | 10 +++
 .../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 +-
 .../gfortran.dg/goacc/ref_inquiry.f90         |  8 ---
 .../gfortran.dg/gomp/ref_inquiry.f90          |  4 --
 libgomp/ChangeLog.omp                         |  7 ++
 .../array-stride-dt-1.f90                     |  5 +-
 10 files changed, 78 insertions(+), 46 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/array-with-dt-6.f90

diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index 007855075563..45c68a38914e 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,10 @@
+2021-02-24  Julian Brown  <julian@codesourcery.com>
+
+	Backport from mainline
+
+	* openmp.c (resolve_omp_clauses): Disallow selecting components
+	of arrays of derived type.
+
 2021-02-24  Julian Brown  <julian@codesourcery.com>
 
 	Backport from mainline
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 8d77f9e73510..7085caf772e1 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -4940,17 +4940,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).
@@ -4958,53 +4972,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/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index 98032a72d4b9..f056b3c8f23d 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,13 @@
+2021-02-24  Julian Brown  <julian@codesourcery.com>
+
+	Backport from mainline
+
+	* 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.
+
 2021-02-24  Julian Brown  <julian@codesourcery.com>
 
 	Backport from mainline
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 e4a6f319772c..807580d75a9c 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 000000000000..adac8e3945eb
--- /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 1372f6af53e9..6b414fb85249 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 69dd38e51974..7f3cc4ae2749 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 374610405601..610d9ec0b950 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/ChangeLog.omp b/libgomp/ChangeLog.omp
index 0f862d1b573a..d1dcf203f5f0 100644
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/ChangeLog.omp
@@ -1,3 +1,10 @@
+2021-02-24  Julian Brown  <julian@codesourcery.com>
+
+	Backport from mainline
+
+	* testsuite/libgomp.oacc-fortran/array-stride-dt-1.f90: Remove
+	expected errors.
+
 2021-02-24  Julian Brown  <julian@codesourcery.com>
 
 	Backport from mainline
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 61250708197d..f04d76d583ab 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


^ permalink raw reply	[flat|nested] 3+ messages in thread

end of thread, other threads:[~2021-02-24 21:58 UTC | newest]

Thread overview: 3+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-02-24 21:58 [PATCH 5/7] [og10] Fortran: %re/%im fixes for OpenMP/OpenACC + gfc_is_simplify_contiguous Julian Brown
2021-02-24 21:58 ` [PATCH 6/7] [og10] openacc: Fix lowering for derived-type mappings through array elements Julian Brown
2021-02-24 21:58 ` [PATCH 7/7] [og10] openacc: Strided array sections and components of derived-type arrays Julian Brown

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).