#include "dependency.h"
#include "constructor.h"
#include "arith.h"
+#include "options.h"
/* static declarations */
/* Enums */
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))
--- /dev/null
+! { 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