Hi Thomas,
On 02.02.21 15:54, Thomas Koenig wrote:
So, while your patch is OK, I think a simple removal of the test
is also OK.
Take your pick :-)
I think I will do a combination: If 'identical' is true, I think I
cannot remove it. If it is false, it can be identical or nonoverlapping
– which makes sense.
Unless there are further comments, I will commit it later.
Tobias
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank
Thürauf
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 | 15 ++++-
.../gfortran.dg/coarray/array_temporary.f90 | 74 ++++++++++++++++++++++
2 files changed, 86 insertions(+), 3 deletions(-)
diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c
index c9baca80cbc..58593ba535b 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 */
@@ -2142,9 +2143,17 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse,
return (fin_dep == GFC_DEP_OVERLAP) ? 1 : 0;
case REF_ARRAY:
-
- /* For now, treat all coarrays as dangerous. */
- if (lref->u.ar.codimen || rref->u.ar.codimen)
+ /* Coarrays: If there is a coindex, either the image differs and there
+ is no overlap or the image is the same - then the normal analysis
+ applies. Hence, return early only if 'identical' is required and
+ either ref is coindexed and more than one image can exist. */
+ if (identical && 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
