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

Reply via email to