return GFC_DEP_EQUAL;
}
+ /* Handle cases like x:y:2 vs. x+1:z:4 as GFC_DEP_NODEP.
+ There is no dependency if the remainder of
+ (l_start - r_start) / gcd(l_stride, r_stride) is
+ nonzero.
+ TODO:
+ - Handle cases where x is an expression.
+ - Cases like a(1:4:2) = a(2:3) are still not handled.
+ */
+
+#define IS_CONSTANT_INTEGER(a) ((a) && ((a)->expr_type == EXPR_CONSTANT) \
+ && (a)->ts.type == BT_INTEGER)
+
+ if (IS_CONSTANT_INTEGER(l_start) && IS_CONSTANT_INTEGER(r_start)
+ && IS_CONSTANT_INTEGER(l_stride) && IS_CONSTANT_INTEGER(r_stride))
+ {
+ mpz_t gcd, tmp;
+ int result;
+
+ mpz_init (gcd);
+ mpz_init (tmp);
+
+ mpz_gcd (gcd, l_stride->value.integer, r_stride->value.integer);
+ mpz_sub (tmp, l_start->value.integer, r_start->value.integer);
+
+ mpz_fdiv_r (tmp, tmp, gcd);
+ result = mpz_cmp_si (tmp, 0L);
+
+ mpz_clear (gcd);
+ mpz_clear (tmp);
+
+ if (result != 0)
+ return GFC_DEP_NODEP;
+ }
+
+#undef IS_CONSTANT_INTEGER
+
/* Check for forward dependencies x:y vs. x+1:z. */
if (l_dir == 1 && r_dir == 1
&& l_start && r_start && gfc_dep_compare_expr (l_start, r_start) == -1
--- /dev/null
+! { dg-do run }
+! { dg-options "-ffree-line-length-none" }
+! Test that different array assignments work even when interleaving,
+! reversing etc. Make sure the results from assignment with constants
+! as array triples and runtime array triples (where we always create
+! a temporary) match.
+#define TST(b,c,d,e,f,g,r) a=init; a(b:c:d) = a(e:f:g); \
+ write(unit=line ,fmt="(9I1)") a;\
+ if (line /= r) call abort ; \
+ call mytst(b,c,d,e,f,g,r);
+
+program main
+ implicit none
+ integer :: i
+ integer, parameter :: n=9
+ integer, dimension(n) :: a
+ character(len=n) :: line
+ integer, dimension(n), parameter :: init = (/(i,i=1,n)/)
+ TST(2,n,2,1,n-1,2,'113355779')
+ TST(3,9,3,2,6,2,'122454786');
+ TST(1,8,2,3,9,2,'325476989');
+ TST(1,6,1,4,9,1,'456789789');
+ TST(9,5,-1,1,5,1,'123454321');
+ TST(9,5,-2,1,5,2,'123456381');
+ TST(5,9,2,5,1,-2,'123456381');
+ TST(1,6,1,2,7,1,'234567789');
+ TST(2,7,1,1,6,1,'112345689');
+end program main
+
+subroutine mytst(b,c,d,e,f,g,r)
+ integer,intent(in) :: b,c,d,e,f,g
+ character(len=9), intent(in) :: r
+ character(len=9) :: line
+ integer, dimension(9) :: a
+ a = (/(i,i=1,9)/)
+ a(b:c:d) = a(e:f:g)
+ write (unit=line,fmt='(9I1)') a
+ if (line /= r) call abort
+end subroutine mytst