openacc: Strided array sections and components of derived-type arrays
authorJulian Brown <julian@codesourcery.com>
Wed, 10 Feb 2021 19:18:13 +0000 (11:18 -0800)
committerJulian Brown <julian@codesourcery.com>
Wed, 17 Feb 2021 14:13:55 +0000 (06:13 -0800)
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.

gcc/fortran/openmp.c
gcc/testsuite/gfortran.dg/goacc/array-with-dt-2.f90
gcc/testsuite/gfortran.dg/goacc/array-with-dt-6.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/goacc/mapping-tests-2.f90
gcc/testsuite/gfortran.dg/goacc/ref_inquiry.f90
gcc/testsuite/gfortran.dg/gomp/ref_inquiry.f90
libgomp/testsuite/libgomp.oacc-fortran/array-stride-dt-1.f90

index 1e541eb..bf01790 100644 (file)
@@ -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",
index e4a6f31..807580d 100644 (file)
@@ -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 (file)
index 0000000..adac8e3
--- /dev/null
@@ -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
index 1372f6a..6b414fb 100644 (file)
@@ -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
index 69dd38e..7f3cc4a 100644 (file)
@@ -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
index 3746104..610d9ec 100644 (file)
@@ -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
index 6125070..f04d76d 100644 (file)
@@ -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)