Commit 278c3214 by Julian Brown

Don't allow mixed component and non-component accesses for OpenACC/Fortran

	gcc/fortran/
	* gfortran.h (gfc_symbol): Add comp_mark bitfield.
	* openmp.c (resolve_omp_clauses): Disallow mixed component and
	full-derived-type accesses to the same variable within a single
	directive.

	libgomp/
	* testsuite/libgomp.oacc-fortran/deep-copy-2.f90: Remove test from here.
	* testsuite/libgomp.oacc-fortran/deep-copy-3.f90: Don't use mixed
	component/non-component variable refs in a single directive.
	* testsuite/libgomp.oacc-fortran/classtypes-1.f95: Likewise.

	gcc/testsuite/
	* gfortran.dg/goacc/deep-copy-2.f90: Move test here (from libgomp
	testsuite). Make a compilation test, and expect rejection of mixed
	component/non-component accesses.
	* gfortran.dg/goacc/mapping-tests-1.f90: New test.
parent 99b9f5b4
2020-01-28 Julian Brown <julian@codesourcery.com>
* gfortran.h (gfc_symbol): Add comp_mark bitfield.
* openmp.c (resolve_omp_clauses): Disallow mixed component and
full-derived-type accesses to the same variable within a single
directive.
2020-01-28 Tobias Burnus <tobias@codesourcery.com> 2020-01-28 Tobias Burnus <tobias@codesourcery.com>
PR fortran/93464 PR fortran/93464
......
...@@ -1592,9 +1592,11 @@ typedef struct gfc_symbol ...@@ -1592,9 +1592,11 @@ typedef struct gfc_symbol
current statement have the mark member nonzero. Of these symbols, current statement have the mark member nonzero. Of these symbols,
symbols with old_symbol equal to NULL are symbols created within symbols with old_symbol equal to NULL are symbols created within
the current statement. Otherwise, old_symbol points to a copy of the current statement. Otherwise, old_symbol points to a copy of
the old symbol. gfc_new is used in symbol.c to flag new symbols. */ the old symbol. gfc_new is used in symbol.c to flag new symbols.
comp_mark is used to indicate variables which have component accesses
in OpenMP/OpenACC directive clauses. */
struct gfc_symbol *old_symbol; struct gfc_symbol *old_symbol;
unsigned mark:1, gfc_new:1; unsigned mark:1, comp_mark:1, gfc_new:1;
/* The tlink field is used in the front end to carry the module /* The tlink field is used in the front end to carry the module
declaration of separate module procedures so that the characteristics declaration of separate module procedures so that the characteristics
......
...@@ -4248,6 +4248,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, ...@@ -4248,6 +4248,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
for (n = omp_clauses->lists[list]; n; n = n->next) for (n = omp_clauses->lists[list]; n; n = n->next)
{ {
n->sym->mark = 0; n->sym->mark = 0;
n->sym->comp_mark = 0;
if (n->sym->attr.flavor == FL_VARIABLE if (n->sym->attr.flavor == FL_VARIABLE
|| n->sym->attr.proc_pointer || n->sym->attr.proc_pointer
|| (!code && (!n->sym->attr.dummy || n->sym->ns != ns))) || (!code && (!n->sym->attr.dummy || n->sym->ns != ns)))
...@@ -4313,23 +4314,25 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, ...@@ -4313,23 +4314,25 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
&& (list != OMP_LIST_REDUCTION || !openacc)) && (list != OMP_LIST_REDUCTION || !openacc))
for (n = omp_clauses->lists[list]; n; n = n->next) for (n = omp_clauses->lists[list]; n; n = n->next)
{ {
bool array_only_p = true; bool component_ref_p = false;
/* Disallow duplicate bare variable references and multiple
subarrays of the same array here, but allow multiple components of /* Allow multiple components of the same (e.g. derived-type)
the same (e.g. derived-type) variable. For the latter, duplicate variable here. Duplicate components are detected elsewhere. */
components are detected elsewhere. */ if (n->expr && n->expr->expr_type == EXPR_VARIABLE)
if (openacc && n->expr && n->expr->expr_type == EXPR_VARIABLE)
for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next) for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
if (ref->type != REF_ARRAY) if (ref->type == REF_COMPONENT)
{ component_ref_p = true;
array_only_p = false; if ((!component_ref_p && n->sym->comp_mark)
break; || (component_ref_p && n->sym->mark))
} gfc_error ("Symbol %qs has mixed component and non-component "
if (array_only_p) "accesses at %L", n->sym->name, &n->where);
else if (n->sym->mark)
gfc_error ("Symbol %qs present on multiple clauses at %L",
n->sym->name, &n->where);
else
{ {
if (n->sym->mark) if (component_ref_p)
gfc_error ("Symbol %qs present on multiple clauses at %L", n->sym->comp_mark = 1;
n->sym->name, &n->where);
else else
n->sym->mark = 1; n->sym->mark = 1;
} }
......
2020-01-28 Julian Brown <julian@codesourcery.com>
* gfortran.dg/goacc/deep-copy-2.f90: Move test here (from libgomp
testsuite). Make a compilation test, and expect rejection of mixed
component/non-component accesses.
* gfortran.dg/goacc/mapping-tests-1.f90: New test.
2020-01-28 Tobias Burnus <tobias@codesourcery.com> 2020-01-28 Tobias Burnus <tobias@codesourcery.com>
Julian Brown <julian@codesourcery.com> Julian Brown <julian@codesourcery.com>
......
! { dg-do run } ! { dg-do compile }
! Test of attach/detach with "acc data", two clauses at once. ! Test of attach/detach with "acc data", two clauses at once.
...@@ -14,7 +14,9 @@ program dtype ...@@ -14,7 +14,9 @@ program dtype
allocate(var%a(1:n)) allocate(var%a(1:n))
!$acc data copy(var) copy(var%a) !$acc data copy(var) copy(var%a) ! { dg-error "Symbol .var. has mixed component and non-component accesses" }
!$acc data copy(var%a) copy(var) ! { dg-error "Symbol .var. has mixed component and non-component accesses" }
!$acc parallel loop !$acc parallel loop
do i = 1,n do i = 1,n
...@@ -24,6 +26,8 @@ program dtype ...@@ -24,6 +26,8 @@ program dtype
!$acc end data !$acc end data
!$acc end data
do i = 1,n do i = 1,n
if (i .ne. var%a(i)) stop 1 if (i .ne. var%a(i)) stop 1
end do end do
......
! { dg-do compile }
subroutine foo
type t
integer :: i, j
end type t
type(t) x
! We should reject the duplicate reference here.
!$acc enter data copyin(x%i, x%i)
! { dg-error ".x.i. appears more than once in map clauses" "" { target "*-*-*" } 11 }
end
2020-01-28 Julian Brown <julian@codesourcery.com>
* testsuite/libgomp.oacc-fortran/deep-copy-2.f90: Remove test from here.
* testsuite/libgomp.oacc-fortran/deep-copy-3.f90: Don't use mixed
component/non-component variable refs in a single directive.
* testsuite/libgomp.oacc-fortran/classtypes-1.f95: Likewise.
2020-01-24 Maciej W. Rozycki <macro@wdc.com> 2020-01-24 Maciej W. Rozycki <macro@wdc.com>
* configure.ac: Handle `--with-toolexeclibdir='. * configure.ac: Handle `--with-toolexeclibdir='.
......
...@@ -31,7 +31,8 @@ program main ...@@ -31,7 +31,8 @@ program main
myvar%p%p(i) = -1.0 myvar%p%p(i) = -1.0
end do end do
!$acc enter data copyin(myvar, myvar%p) create(myvar%p%p) !$acc enter data copyin(myvar)
!$acc enter data copyin(myvar%p) create(myvar%p%p)
!$acc parallel loop present(myvar%p%p) !$acc parallel loop present(myvar%p%p)
do i=1,100 do i=1,100
...@@ -39,7 +40,8 @@ program main ...@@ -39,7 +40,8 @@ program main
end do end do
!$acc end parallel loop !$acc end parallel loop
!$acc exit data copyout(myvar%p%p) delete(myvar, myvar%p) !$acc exit data copyout(myvar%p%p) delete(myvar%p)
!$acc exit data delete(myvar)
do i=1,100 do i=1,100
if (myvar%p%p(i) .ne. i * 2) stop 1 if (myvar%p%p(i) .ne. i * 2) stop 1
......
...@@ -16,12 +16,14 @@ program dtype ...@@ -16,12 +16,14 @@ program dtype
allocate(var%a(1:n)) allocate(var%a(1:n))
allocate(var%b(1:n)) allocate(var%b(1:n))
!$acc parallel loop copy(var) copy(var%a(1:n)) copy(var%b(1:n)) !$acc data copy(var)
!$acc parallel loop copy(var%a(1:n)) copy(var%b(1:n))
do i = 1,n do i = 1,n
var%a(i) = i var%a(i) = i
var%b(i) = i var%b(i) = i
end do end do
!$acc end parallel loop !$acc end parallel loop
!$acc end data
do i = 1,n do i = 1,n
if (i .ne. var%a(i)) stop 1 if (i .ne. var%a(i)) stop 1
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment