Fortran: Fix Array dependency with local coarrays [PR98913] gcc/fortran/ChangeLog: PR fortran/98913 * dependency.c (gfc_dep_resolver): Treat local access to coarrays like any array access in dependency analysis. gcc/testsuite/ChangeLog: PR fortran/98913 * gfortran.dg/coarray/array_temporary.f90: New test. gcc/fortran/dependency.c | 11 +++- .../gfortran.dg/coarray/array_temporary.f90 | 74 ++++++++++++++++++++++ 2 files changed, 83 insertions(+), 2 deletions(-) diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c index c9baca80cbc..0de5d093aab 100644 --- a/gcc/fortran/dependency.c +++ b/gcc/fortran/dependency.c @@ -30,6 +30,7 @@ along with GCC; see the file COPYING3. If not see #include "dependency.h" #include "constructor.h" #include "arith.h" +#include "options.h" /* static declarations */ /* Enums */ @@ -2143,8 +2144,14 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse, case REF_ARRAY: - /* For now, treat all coarrays as dangerous. */ - if (lref->u.ar.codimen || rref->u.ar.codimen) + /* For now, treat all nonlocal coarrays as dangerous. */ + if (flag_coarray != GFC_FCOARRAY_SINGLE + && ((lref->u.ar.codimen + && lref->u.ar.dimen_type[lref->u.ar.dimen] + != DIMEN_THIS_IMAGE) + || (rref->u.ar.codimen + && lref->u.ar.dimen_type[lref->u.ar.dimen] + != DIMEN_THIS_IMAGE))) return 1; if (ref_same_as_full_array (lref, rref)) diff --git a/gcc/testsuite/gfortran.dg/coarray/array_temporary.f90 b/gcc/testsuite/gfortran.dg/coarray/array_temporary.f90 new file mode 100644 index 00000000000..86460a7c282 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray/array_temporary.f90 @@ -0,0 +1,74 @@ +! { dg-do compile } +! { dg-additional-options "-Warray-temporaries" } +! +! PR fortran/98913 +! +! Contributed by Jorge D'Elia +! +! Did create an array temporary for local access to coarray +! (but not for identical noncoarray use). +! + +program test + implicit none + integer, parameter :: iin = kind (1) + integer, parameter :: idp = kind (1.0d0) + real (kind=idp), allocatable :: AA (:,:)[:] + real (kind=idp), allocatable :: BB (:,:) + real (kind=idp), allocatable :: UU (:) + integer (kind=iin) :: nn, n1, n2 + integer (kind=iin) :: j, k, k1 + ! + nn = 5 + n1 = 1 + n2 = 10 + ! + allocate (AA (1:nn,n1:n2)[*]) + allocate (BB (1:nn,n1:n2)) + allocate (UU (1:nn)) + ! + k = 1 + k1 = k + 1 + ! + AA = 1.0_idp + BB = 1.0_idp + UU = 2.0_idp + + ! AA - coarrays + ! No temporary needed: + do j = 1, nn + AA (k1:nn,j) = AA (k1:nn,j) - UU (k1:nn) * AA (k,j) ! { dg-bogus "Creating array temporary" } + end do + do j = 1, nn + AA (k1:nn,j) = AA (k1:nn,j) - UU (k1:nn) * AA (k,j) - UU(k) * AA (k1-1:nn-1,j) ! { dg-bogus "Creating array temporary" } + end do + do j = 1, nn + AA (k1:nn,j) = AA (k1:nn,j) - UU (k1:nn) * AA (k,j) - UU(k) * AA (k1+1:nn+1,j) ! { dg-bogus "Creating array temporary" } + end do + + ! But: + do j = 1, nn + AA (k1:nn,j) = AA (k1-1:nn-1,j) - UU (k1:nn) * AA (k,j) - UU(k) * AA (k1+1:nn+1,j) ! { dg-warning "Creating array temporary" } + end do + + ! BB - no coarrays + ! No temporary needed: + do j = 1, nn + BB (k1:nn,j) = BB (k1:nn,j) - UU (k1:nn) * BB (k,j) ! { dg-bogus "Creating array temporary" } + end do + do j = 1, nn + BB (k1:nn,j) = BB (k1:nn,j) - UU (k1:nn) * BB (k,j) - UU(k) * BB (k1-1:nn-1,j) ! { dg-bogus "Creating array temporary" } + end do + do j = 1, nn + BB (k1:nn,j) = BB (k1:nn,j) - UU (k1:nn) * BB (k,j) - UU(k) * BB (k1+1:nn+1,j) ! { dg-bogus "Creating array temporary" } + end do + + ! But: + do j = 1, nn + BB (k1:nn,j) = BB (k1-1:nn-1,j) - UU (k1:nn) * BB (k,j) - UU(k) * BB (k1+1:nn+1,j) ! { dg-warning "Creating array temporary" } + end do + + deallocate (AA) + deallocate (BB) + deallocate (UU) +end program test