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

[Julian Brown <julian@codesourcery.com>]

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