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.
This commit is contained in:
Julian Brown 2021-02-10 11:18:13 -08:00
parent d28f3da11d
commit 366cf1127a
7 changed files with 54 additions and 46 deletions

View 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",

View 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

View file

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

View 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

View 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

View 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

View 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)