From e3f9f80bfa9e58a90dfe75631921c78660342daf Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Wed, 3 Feb 2021 10:34:18 +0100
Subject: [PATCH] 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(-)
 create mode 100644 gcc/testsuite/gfortran.dg/coarray/array_temporary.f90

diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c
index c9baca80cbc..5de3b2cf520 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
-- 
2.30.2