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.

diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c
index c9baca80cbcd264c9fb1c5b726c24428ff586db3..5de3b2cf5208846b9aa17d02140822ee06436436 100644 (file)
--- 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 (file)
index 0000000..86460a7
--- /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