2 Copyright (C) 2000, 2001, 2002, 2005, 2006, 2007, 2008, 2009, 2010
3 Free Software Foundation, Inc.
4 Contributed by Paul Brook <paul@nowt.org>
6 This file is part of GCC.
8 GCC is free software; you can redistribute it and/or modify it under
9 the terms of the GNU General Public License as published by the Free
10 Software Foundation; either version 3, or (at your option) any later
13 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
14 WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
18 You should have received a copy of the GNU General Public License
19 along with GCC; see the file COPYING3. If not see
20 <http://www.gnu.org/licenses/>. */
22 /* dependency.c -- Expression dependency analysis code. */
23 /* There's probably quite a bit of duplication in this file. We currently
24 have different dependency checking functions for different types
25 if dependencies. Ideally these would probably be merged. */
30 #include "dependency.h"
31 #include "constructor.h"
33 /* static declarations */
35 enum range
{LHS
, RHS
, MID
};
37 /* Dependency types. These must be in reverse order of priority. */
41 GFC_DEP_EQUAL
, /* Identical Ranges. */
42 GFC_DEP_FORWARD
, /* e.g., a(1:3) = a(2:4). */
43 GFC_DEP_BACKWARD
, /* e.g. a(2:4) = a(1:3). */
44 GFC_DEP_OVERLAP
, /* May overlap in some other way. */
45 GFC_DEP_NODEP
/* Distinct ranges. */
50 #define IS_ARRAY_EXPLICIT(as) ((as->type == AS_EXPLICIT ? 1 : 0))
53 /* Returns 1 if the expr is an integer constant value 1, 0 if it is not or
54 def if the value could not be determined. */
57 gfc_expr_is_one (gfc_expr
*expr
, int def
)
59 gcc_assert (expr
!= NULL
);
61 if (expr
->expr_type
!= EXPR_CONSTANT
)
64 if (expr
->ts
.type
!= BT_INTEGER
)
67 return mpz_cmp_si (expr
->value
.integer
, 1) == 0;
71 /* Compare two values. Returns 0 if e1 == e2, -1 if e1 < e2, +1 if e1 > e2,
72 and -2 if the relationship could not be determined. */
75 gfc_dep_compare_expr (gfc_expr
*e1
, gfc_expr
*e2
)
77 gfc_actual_arglist
*args1
;
78 gfc_actual_arglist
*args2
;
81 if (e1
->expr_type
== EXPR_OP
82 && (e1
->value
.op
.op
== INTRINSIC_UPLUS
83 || e1
->value
.op
.op
== INTRINSIC_PARENTHESES
))
84 return gfc_dep_compare_expr (e1
->value
.op
.op1
, e2
);
85 if (e2
->expr_type
== EXPR_OP
86 && (e2
->value
.op
.op
== INTRINSIC_UPLUS
87 || e2
->value
.op
.op
== INTRINSIC_PARENTHESES
))
88 return gfc_dep_compare_expr (e1
, e2
->value
.op
.op1
);
90 if (e1
->expr_type
== EXPR_OP
&& e1
->value
.op
.op
== INTRINSIC_PLUS
)
92 /* Compare X+C vs. X. */
93 if (e1
->value
.op
.op2
->expr_type
== EXPR_CONSTANT
94 && e1
->value
.op
.op2
->ts
.type
== BT_INTEGER
95 && gfc_dep_compare_expr (e1
->value
.op
.op1
, e2
) == 0)
96 return mpz_sgn (e1
->value
.op
.op2
->value
.integer
);
98 /* Compare P+Q vs. R+S. */
99 if (e2
->expr_type
== EXPR_OP
&& e2
->value
.op
.op
== INTRINSIC_PLUS
)
103 l
= gfc_dep_compare_expr (e1
->value
.op
.op1
, e2
->value
.op
.op1
);
104 r
= gfc_dep_compare_expr (e1
->value
.op
.op2
, e2
->value
.op
.op2
);
105 if (l
== 0 && r
== 0)
107 if (l
== 0 && r
!= -2)
109 if (l
!= -2 && r
== 0)
111 if (l
== 1 && r
== 1)
113 if (l
== -1 && r
== -1)
116 l
= gfc_dep_compare_expr (e1
->value
.op
.op1
, e2
->value
.op
.op2
);
117 r
= gfc_dep_compare_expr (e1
->value
.op
.op2
, e2
->value
.op
.op1
);
118 if (l
== 0 && r
== 0)
120 if (l
== 0 && r
!= -2)
122 if (l
!= -2 && r
== 0)
124 if (l
== 1 && r
== 1)
126 if (l
== -1 && r
== -1)
131 /* Compare X vs. X+C. */
132 if (e2
->expr_type
== EXPR_OP
&& e2
->value
.op
.op
== INTRINSIC_PLUS
)
134 if (e2
->value
.op
.op2
->expr_type
== EXPR_CONSTANT
135 && e2
->value
.op
.op2
->ts
.type
== BT_INTEGER
136 && gfc_dep_compare_expr (e1
, e2
->value
.op
.op1
) == 0)
137 return -mpz_sgn (e2
->value
.op
.op2
->value
.integer
);
140 /* Compare X-C vs. X. */
141 if (e1
->expr_type
== EXPR_OP
&& e1
->value
.op
.op
== INTRINSIC_MINUS
)
143 if (e1
->value
.op
.op2
->expr_type
== EXPR_CONSTANT
144 && e1
->value
.op
.op2
->ts
.type
== BT_INTEGER
145 && gfc_dep_compare_expr (e1
->value
.op
.op1
, e2
) == 0)
146 return -mpz_sgn (e1
->value
.op
.op2
->value
.integer
);
148 /* Compare P-Q vs. R-S. */
149 if (e2
->expr_type
== EXPR_OP
&& e2
->value
.op
.op
== INTRINSIC_MINUS
)
153 l
= gfc_dep_compare_expr (e1
->value
.op
.op1
, e2
->value
.op
.op1
);
154 r
= gfc_dep_compare_expr (e1
->value
.op
.op2
, e2
->value
.op
.op2
);
155 if (l
== 0 && r
== 0)
157 if (l
!= -2 && r
== 0)
159 if (l
== 0 && r
!= -2)
161 if (l
== 1 && r
== -1)
163 if (l
== -1 && r
== 1)
168 /* Compare X vs. X-C. */
169 if (e2
->expr_type
== EXPR_OP
&& e2
->value
.op
.op
== INTRINSIC_MINUS
)
171 if (e2
->value
.op
.op2
->expr_type
== EXPR_CONSTANT
172 && e2
->value
.op
.op2
->ts
.type
== BT_INTEGER
173 && gfc_dep_compare_expr (e1
, e2
->value
.op
.op1
) == 0)
174 return mpz_sgn (e2
->value
.op
.op2
->value
.integer
);
177 if (e1
->expr_type
!= e2
->expr_type
)
180 switch (e1
->expr_type
)
183 if (e1
->ts
.type
!= BT_INTEGER
|| e2
->ts
.type
!= BT_INTEGER
)
186 i
= mpz_cmp (e1
->value
.integer
, e2
->value
.integer
);
194 if (e1
->ref
|| e2
->ref
)
196 if (e1
->symtree
->n
.sym
== e2
->symtree
->n
.sym
)
201 /* Intrinsic operators are the same if their operands are the same. */
202 if (e1
->value
.op
.op
!= e2
->value
.op
.op
)
204 if (e1
->value
.op
.op2
== 0)
206 i
= gfc_dep_compare_expr (e1
->value
.op
.op1
, e2
->value
.op
.op1
);
207 return i
== 0 ? 0 : -2;
209 if (gfc_dep_compare_expr (e1
->value
.op
.op1
, e2
->value
.op
.op1
) == 0
210 && gfc_dep_compare_expr (e1
->value
.op
.op2
, e2
->value
.op
.op2
) == 0)
212 /* TODO Handle commutative binary operators here? */
216 /* We can only compare calls to the same intrinsic function. */
217 if (e1
->value
.function
.isym
== 0 || e2
->value
.function
.isym
== 0
218 || e1
->value
.function
.isym
!= e2
->value
.function
.isym
)
221 args1
= e1
->value
.function
.actual
;
222 args2
= e2
->value
.function
.actual
;
224 /* We should list the "constant" intrinsic functions. Those
225 without side-effects that provide equal results given equal
227 switch (e1
->value
.function
.isym
->id
)
229 case GFC_ISYM_CONVERSION
:
230 /* Handle integer extensions specially, as __convert_i4_i8
231 is not only "constant" but also "unary" and "increasing". */
232 if (args1
&& !args1
->next
233 && args2
&& !args2
->next
234 && e1
->ts
.type
== BT_INTEGER
235 && args1
->expr
->ts
.type
== BT_INTEGER
236 && e1
->ts
.kind
> args1
->expr
->ts
.kind
237 && e2
->ts
.type
== e1
->ts
.type
238 && e2
->ts
.kind
== e1
->ts
.kind
239 && args2
->expr
->ts
.type
== args1
->expr
->ts
.type
240 && args2
->expr
->ts
.kind
== args2
->expr
->ts
.kind
)
241 return gfc_dep_compare_expr (args1
->expr
, args2
->expr
);
245 case GFC_ISYM_LOGICAL
:
253 /* Compare the argument lists for equality. */
254 while (args1
&& args2
)
256 if (gfc_dep_compare_expr (args1
->expr
, args2
->expr
) != 0)
261 return (args1
|| args2
) ? -2 : 0;
269 /* Returns 1 if the two ranges are the same, 0 if they are not, and def
270 if the results are indeterminate. N is the dimension to compare. */
273 gfc_is_same_range (gfc_array_ref
*ar1
, gfc_array_ref
*ar2
, int n
, int def
)
279 /* TODO: More sophisticated range comparison. */
280 gcc_assert (ar1
&& ar2
);
282 gcc_assert (ar1
->dimen_type
[n
] == ar2
->dimen_type
[n
]);
286 /* Check for mismatching strides. A NULL stride means a stride of 1. */
289 i
= gfc_expr_is_one (e1
, -1);
297 i
= gfc_expr_is_one (e2
, -1);
305 i
= gfc_dep_compare_expr (e1
, e2
);
311 /* The strides match. */
313 /* Check the range start. */
318 /* Use the bound of the array if no bound is specified. */
320 e1
= ar1
->as
->lower
[n
];
323 e2
= ar2
->as
->lower
[n
];
325 /* Check we have values for both. */
329 i
= gfc_dep_compare_expr (e1
, e2
);
336 /* Check the range end. */
341 /* Use the bound of the array if no bound is specified. */
343 e1
= ar1
->as
->upper
[n
];
346 e2
= ar2
->as
->upper
[n
];
348 /* Check we have values for both. */
352 i
= gfc_dep_compare_expr (e1
, e2
);
363 /* Some array-returning intrinsics can be implemented by reusing the
364 data from one of the array arguments. For example, TRANSPOSE does
365 not necessarily need to allocate new data: it can be implemented
366 by copying the original array's descriptor and simply swapping the
367 two dimension specifications.
369 If EXPR is a call to such an intrinsic, return the argument
370 whose data can be reused, otherwise return NULL. */
373 gfc_get_noncopying_intrinsic_argument (gfc_expr
*expr
)
375 if (expr
->expr_type
!= EXPR_FUNCTION
|| !expr
->value
.function
.isym
)
378 switch (expr
->value
.function
.isym
->id
)
380 case GFC_ISYM_TRANSPOSE
:
381 return expr
->value
.function
.actual
->expr
;
389 /* Return true if the result of reference REF can only be constructed
390 using a temporary array. */
393 gfc_ref_needs_temporary_p (gfc_ref
*ref
)
399 for (; ref
; ref
= ref
->next
)
403 /* Vector dimensions are generally not monotonic and must be
404 handled using a temporary. */
405 if (ref
->u
.ar
.type
== AR_SECTION
)
406 for (n
= 0; n
< ref
->u
.ar
.dimen
; n
++)
407 if (ref
->u
.ar
.dimen_type
[n
] == DIMEN_VECTOR
)
414 /* Within an array reference, character substrings generally
415 need a temporary. Character array strides are expressed as
416 multiples of the element size (consistent with other array
417 types), not in characters. */
429 gfc_is_data_pointer (gfc_expr
*e
)
433 if (e
->expr_type
!= EXPR_VARIABLE
&& e
->expr_type
!= EXPR_FUNCTION
)
436 /* No subreference if it is a function */
437 gcc_assert (e
->expr_type
== EXPR_VARIABLE
|| !e
->ref
);
439 if (e
->symtree
->n
.sym
->attr
.pointer
)
442 for (ref
= e
->ref
; ref
; ref
= ref
->next
)
443 if (ref
->type
== REF_COMPONENT
&& ref
->u
.c
.component
->attr
.pointer
)
450 /* Return true if array variable VAR could be passed to the same function
451 as argument EXPR without interfering with EXPR. INTENT is the intent
454 This is considerably less conservative than other dependencies
455 because many function arguments will already be copied into a
459 gfc_check_argument_var_dependency (gfc_expr
*var
, sym_intent intent
,
460 gfc_expr
*expr
, gfc_dep_check elemental
)
464 gcc_assert (var
->expr_type
== EXPR_VARIABLE
);
465 gcc_assert (var
->rank
> 0);
467 switch (expr
->expr_type
)
470 /* In case of elemental subroutines, there is no dependency
471 between two same-range array references. */
472 if (gfc_ref_needs_temporary_p (expr
->ref
)
473 || gfc_check_dependency (var
, expr
, elemental
== NOT_ELEMENTAL
))
475 if (elemental
== ELEM_DONT_CHECK_VARIABLE
)
477 /* Too many false positive with pointers. */
478 if (!gfc_is_data_pointer (var
) && !gfc_is_data_pointer (expr
))
480 /* Elemental procedures forbid unspecified intents,
481 and we don't check dependencies for INTENT_IN args. */
482 gcc_assert (intent
== INTENT_OUT
|| intent
== INTENT_INOUT
);
484 /* We are told not to check dependencies.
485 We do it, however, and issue a warning in case we find one.
486 If a dependency is found in the case
487 elemental == ELEM_CHECK_VARIABLE, we will generate
488 a temporary, so we don't need to bother the user. */
489 gfc_warning ("INTENT(%s) actual argument at %L might "
490 "interfere with actual argument at %L.",
491 intent
== INTENT_OUT
? "OUT" : "INOUT",
492 &var
->where
, &expr
->where
);
502 return gfc_check_dependency (var
, expr
, 1);
505 if (intent
!= INTENT_IN
&& expr
->inline_noncopying_intrinsic
506 && (arg
= gfc_get_noncopying_intrinsic_argument (expr
))
507 && gfc_check_argument_var_dependency (var
, intent
, arg
, elemental
))
511 if ((expr
->value
.function
.esym
512 && expr
->value
.function
.esym
->attr
.elemental
)
513 || (expr
->value
.function
.isym
514 && expr
->value
.function
.isym
->elemental
))
515 return gfc_check_fncall_dependency (var
, intent
, NULL
,
516 expr
->value
.function
.actual
,
517 ELEM_CHECK_VARIABLE
);
522 /* In case of non-elemental procedures, there is no need to catch
523 dependencies, as we will make a temporary anyway. */
526 /* If the actual arg EXPR is an expression, we need to catch
527 a dependency between variables in EXPR and VAR,
528 an intent((IN)OUT) variable. */
529 if (expr
->value
.op
.op1
530 && gfc_check_argument_var_dependency (var
, intent
,
532 ELEM_CHECK_VARIABLE
))
534 else if (expr
->value
.op
.op2
535 && gfc_check_argument_var_dependency (var
, intent
,
537 ELEM_CHECK_VARIABLE
))
548 /* Like gfc_check_argument_var_dependency, but extended to any
549 array expression OTHER, not just variables. */
552 gfc_check_argument_dependency (gfc_expr
*other
, sym_intent intent
,
553 gfc_expr
*expr
, gfc_dep_check elemental
)
555 switch (other
->expr_type
)
558 return gfc_check_argument_var_dependency (other
, intent
, expr
, elemental
);
561 if (other
->inline_noncopying_intrinsic
)
563 other
= gfc_get_noncopying_intrinsic_argument (other
);
564 return gfc_check_argument_dependency (other
, INTENT_IN
, expr
,
575 /* Like gfc_check_argument_dependency, but check all the arguments in ACTUAL.
576 FNSYM is the function being called, or NULL if not known. */
579 gfc_check_fncall_dependency (gfc_expr
*other
, sym_intent intent
,
580 gfc_symbol
*fnsym
, gfc_actual_arglist
*actual
,
581 gfc_dep_check elemental
)
583 gfc_formal_arglist
*formal
;
586 formal
= fnsym
? fnsym
->formal
: NULL
;
587 for (; actual
; actual
= actual
->next
, formal
= formal
? formal
->next
: NULL
)
591 /* Skip args which are not present. */
595 /* Skip other itself. */
599 /* Skip intent(in) arguments if OTHER itself is intent(in). */
600 if (formal
&& intent
== INTENT_IN
601 && formal
->sym
->attr
.intent
== INTENT_IN
)
604 if (gfc_check_argument_dependency (other
, intent
, expr
, elemental
))
612 /* Return 1 if e1 and e2 are equivalenced arrays, either
613 directly or indirectly; i.e., equivalence (a,b) for a and b
614 or equivalence (a,c),(b,c). This function uses the equiv_
615 lists, generated in trans-common(add_equivalences), that are
616 guaranteed to pick up indirect equivalences. We explicitly
617 check for overlap using the offset and length of the equivalence.
618 This function is symmetric.
619 TODO: This function only checks whether the full top-level
620 symbols overlap. An improved implementation could inspect
621 e1->ref and e2->ref to determine whether the actually accessed
622 portions of these variables/arrays potentially overlap. */
625 gfc_are_equivalenced_arrays (gfc_expr
*e1
, gfc_expr
*e2
)
628 gfc_equiv_info
*s
, *fl1
, *fl2
;
630 gcc_assert (e1
->expr_type
== EXPR_VARIABLE
631 && e2
->expr_type
== EXPR_VARIABLE
);
633 if (!e1
->symtree
->n
.sym
->attr
.in_equivalence
634 || !e2
->symtree
->n
.sym
->attr
.in_equivalence
|| !e1
->rank
|| !e2
->rank
)
637 if (e1
->symtree
->n
.sym
->ns
638 && e1
->symtree
->n
.sym
->ns
!= gfc_current_ns
)
639 l
= e1
->symtree
->n
.sym
->ns
->equiv_lists
;
641 l
= gfc_current_ns
->equiv_lists
;
643 /* Go through the equiv_lists and return 1 if the variables
644 e1 and e2 are members of the same group and satisfy the
645 requirement on their relative offsets. */
646 for (; l
; l
= l
->next
)
650 for (s
= l
->equiv
; s
; s
= s
->next
)
652 if (s
->sym
== e1
->symtree
->n
.sym
)
658 if (s
->sym
== e2
->symtree
->n
.sym
)
668 /* Can these lengths be zero? */
669 if (fl1
->length
<= 0 || fl2
->length
<= 0)
671 /* These can't overlap if [f11,fl1+length] is before
672 [fl2,fl2+length], or [fl2,fl2+length] is before
673 [fl1,fl1+length], otherwise they do overlap. */
674 if (fl1
->offset
+ fl1
->length
> fl2
->offset
675 && fl2
->offset
+ fl2
->length
> fl1
->offset
)
683 /* Return true if there is no possibility of aliasing because of a type
684 mismatch between all the possible pointer references and the
685 potential target. Note that this function is asymmetric in the
686 arguments and so must be called twice with the arguments exchanged. */
689 check_data_pointer_types (gfc_expr
*expr1
, gfc_expr
*expr2
)
695 bool seen_component_ref
;
697 if (expr1
->expr_type
!= EXPR_VARIABLE
698 || expr1
->expr_type
!= EXPR_VARIABLE
)
701 sym1
= expr1
->symtree
->n
.sym
;
702 sym2
= expr2
->symtree
->n
.sym
;
704 /* Keep it simple for now. */
705 if (sym1
->ts
.type
== BT_DERIVED
&& sym2
->ts
.type
== BT_DERIVED
)
708 if (sym1
->attr
.pointer
)
710 if (gfc_compare_types (&sym1
->ts
, &sym2
->ts
))
714 /* This is a conservative check on the components of the derived type
715 if no component references have been seen. Since we will not dig
716 into the components of derived type components, we play it safe by
717 returning false. First we check the reference chain and then, if
718 no component references have been seen, the components. */
719 seen_component_ref
= false;
720 if (sym1
->ts
.type
== BT_DERIVED
)
722 for (ref1
= expr1
->ref
; ref1
; ref1
= ref1
->next
)
724 if (ref1
->type
!= REF_COMPONENT
)
727 if (ref1
->u
.c
.component
->ts
.type
== BT_DERIVED
)
730 if ((sym2
->attr
.pointer
|| ref1
->u
.c
.component
->attr
.pointer
)
731 && gfc_compare_types (&ref1
->u
.c
.component
->ts
, &sym2
->ts
))
734 seen_component_ref
= true;
738 if (sym1
->ts
.type
== BT_DERIVED
&& !seen_component_ref
)
740 for (cm1
= sym1
->ts
.u
.derived
->components
; cm1
; cm1
= cm1
->next
)
742 if (cm1
->ts
.type
== BT_DERIVED
)
745 if ((sym2
->attr
.pointer
|| cm1
->attr
.pointer
)
746 && gfc_compare_types (&cm1
->ts
, &sym2
->ts
))
755 /* Return true if the statement body redefines the condition. Returns
756 true if expr2 depends on expr1. expr1 should be a single term
757 suitable for the lhs of an assignment. The IDENTICAL flag indicates
758 whether array references to the same symbol with identical range
759 references count as a dependency or not. Used for forall and where
760 statements. Also used with functions returning arrays without a
764 gfc_check_dependency (gfc_expr
*expr1
, gfc_expr
*expr2
, bool identical
)
766 gfc_actual_arglist
*actual
;
770 gcc_assert (expr1
->expr_type
== EXPR_VARIABLE
);
772 switch (expr2
->expr_type
)
775 n
= gfc_check_dependency (expr1
, expr2
->value
.op
.op1
, identical
);
778 if (expr2
->value
.op
.op2
)
779 return gfc_check_dependency (expr1
, expr2
->value
.op
.op2
, identical
);
783 /* The interesting cases are when the symbols don't match. */
784 if (expr1
->symtree
->n
.sym
!= expr2
->symtree
->n
.sym
)
786 gfc_typespec
*ts1
= &expr1
->symtree
->n
.sym
->ts
;
787 gfc_typespec
*ts2
= &expr2
->symtree
->n
.sym
->ts
;
789 /* Return 1 if expr1 and expr2 are equivalenced arrays. */
790 if (gfc_are_equivalenced_arrays (expr1
, expr2
))
793 /* Symbols can only alias if they have the same type. */
794 if (ts1
->type
!= BT_UNKNOWN
&& ts2
->type
!= BT_UNKNOWN
795 && ts1
->type
!= BT_DERIVED
&& ts2
->type
!= BT_DERIVED
)
797 if (ts1
->type
!= ts2
->type
|| ts1
->kind
!= ts2
->kind
)
801 /* If either variable is a pointer, assume the worst. */
802 /* TODO: -fassume-no-pointer-aliasing */
803 if (gfc_is_data_pointer (expr1
) || gfc_is_data_pointer (expr2
))
805 if (check_data_pointer_types (expr1
, expr2
)
806 && check_data_pointer_types (expr2
, expr1
))
813 gfc_symbol
*sym1
= expr1
->symtree
->n
.sym
;
814 gfc_symbol
*sym2
= expr2
->symtree
->n
.sym
;
815 if (sym1
->attr
.target
&& sym2
->attr
.target
816 && ((sym1
->attr
.dummy
&& !sym1
->attr
.contiguous
817 && (!sym1
->attr
.dimension
818 || sym2
->as
->type
== AS_ASSUMED_SHAPE
))
819 || (sym2
->attr
.dummy
&& !sym2
->attr
.contiguous
820 && (!sym2
->attr
.dimension
821 || sym2
->as
->type
== AS_ASSUMED_SHAPE
))))
825 /* Otherwise distinct symbols have no dependencies. */
832 /* Identical and disjoint ranges return 0,
833 overlapping ranges return 1. */
834 if (expr1
->ref
&& expr2
->ref
)
835 return gfc_dep_resolver (expr1
->ref
, expr2
->ref
, NULL
);
840 if (expr2
->inline_noncopying_intrinsic
)
842 /* Remember possible differences between elemental and
843 transformational functions. All functions inside a FORALL
845 for (actual
= expr2
->value
.function
.actual
;
846 actual
; actual
= actual
->next
)
850 n
= gfc_check_dependency (expr1
, actual
->expr
, identical
);
861 /* Loop through the array constructor's elements. */
862 for (c
= gfc_constructor_first (expr2
->value
.constructor
);
863 c
; c
= gfc_constructor_next (c
))
865 /* If this is an iterator, assume the worst. */
868 /* Avoid recursion in the common case. */
869 if (c
->expr
->expr_type
== EXPR_CONSTANT
)
871 if (gfc_check_dependency (expr1
, c
->expr
, 1))
882 /* Determines overlapping for two array sections. */
884 static gfc_dependency
885 gfc_check_section_vs_section (gfc_ref
*lref
, gfc_ref
*rref
, int n
)
906 /* If they are the same range, return without more ado. */
907 if (gfc_is_same_range (&l_ar
, &r_ar
, n
, 0))
908 return GFC_DEP_EQUAL
;
910 l_start
= l_ar
.start
[n
];
912 l_stride
= l_ar
.stride
[n
];
914 r_start
= r_ar
.start
[n
];
916 r_stride
= r_ar
.stride
[n
];
918 /* If l_start is NULL take it from array specifier. */
919 if (NULL
== l_start
&& IS_ARRAY_EXPLICIT (l_ar
.as
))
920 l_start
= l_ar
.as
->lower
[n
];
921 /* If l_end is NULL take it from array specifier. */
922 if (NULL
== l_end
&& IS_ARRAY_EXPLICIT (l_ar
.as
))
923 l_end
= l_ar
.as
->upper
[n
];
925 /* If r_start is NULL take it from array specifier. */
926 if (NULL
== r_start
&& IS_ARRAY_EXPLICIT (r_ar
.as
))
927 r_start
= r_ar
.as
->lower
[n
];
928 /* If r_end is NULL take it from array specifier. */
929 if (NULL
== r_end
&& IS_ARRAY_EXPLICIT (r_ar
.as
))
930 r_end
= r_ar
.as
->upper
[n
];
932 /* Determine whether the l_stride is positive or negative. */
935 else if (l_stride
->expr_type
== EXPR_CONSTANT
936 && l_stride
->ts
.type
== BT_INTEGER
)
937 l_dir
= mpz_sgn (l_stride
->value
.integer
);
938 else if (l_start
&& l_end
)
939 l_dir
= gfc_dep_compare_expr (l_end
, l_start
);
943 /* Determine whether the r_stride is positive or negative. */
946 else if (r_stride
->expr_type
== EXPR_CONSTANT
947 && r_stride
->ts
.type
== BT_INTEGER
)
948 r_dir
= mpz_sgn (r_stride
->value
.integer
);
949 else if (r_start
&& r_end
)
950 r_dir
= gfc_dep_compare_expr (r_end
, r_start
);
954 /* The strides should never be zero. */
955 if (l_dir
== 0 || r_dir
== 0)
956 return GFC_DEP_OVERLAP
;
958 /* Determine LHS upper and lower bounds. */
964 else if (l_dir
== -1)
975 /* Determine RHS upper and lower bounds. */
981 else if (r_dir
== -1)
992 /* Check whether the ranges are disjoint. */
993 if (l_upper
&& r_lower
&& gfc_dep_compare_expr (l_upper
, r_lower
) == -1)
994 return GFC_DEP_NODEP
;
995 if (r_upper
&& l_lower
&& gfc_dep_compare_expr (r_upper
, l_lower
) == -1)
996 return GFC_DEP_NODEP
;
998 /* Handle cases like x:y:1 vs. x:z:-1 as GFC_DEP_EQUAL. */
999 if (l_start
&& r_start
&& gfc_dep_compare_expr (l_start
, r_start
) == 0)
1001 if (l_dir
== 1 && r_dir
== -1)
1002 return GFC_DEP_EQUAL
;
1003 if (l_dir
== -1 && r_dir
== 1)
1004 return GFC_DEP_EQUAL
;
1007 /* Handle cases like x:y:1 vs. z:y:-1 as GFC_DEP_EQUAL. */
1008 if (l_end
&& r_end
&& gfc_dep_compare_expr (l_end
, r_end
) == 0)
1010 if (l_dir
== 1 && r_dir
== -1)
1011 return GFC_DEP_EQUAL
;
1012 if (l_dir
== -1 && r_dir
== 1)
1013 return GFC_DEP_EQUAL
;
1016 /* Handle cases like x:y:2 vs. x+1:z:4 as GFC_DEP_NODEP.
1017 There is no dependency if the remainder of
1018 (l_start - r_start) / gcd(l_stride, r_stride) is
1021 - Handle cases where x is an expression.
1022 - Cases like a(1:4:2) = a(2:3) are still not handled.
1025 #define IS_CONSTANT_INTEGER(a) ((a) && ((a)->expr_type == EXPR_CONSTANT) \
1026 && (a)->ts.type == BT_INTEGER)
1028 if (IS_CONSTANT_INTEGER(l_start
) && IS_CONSTANT_INTEGER(r_start
)
1029 && IS_CONSTANT_INTEGER(l_stride
) && IS_CONSTANT_INTEGER(r_stride
))
1037 mpz_gcd (gcd
, l_stride
->value
.integer
, r_stride
->value
.integer
);
1038 mpz_sub (tmp
, l_start
->value
.integer
, r_start
->value
.integer
);
1040 mpz_fdiv_r (tmp
, tmp
, gcd
);
1041 result
= mpz_cmp_si (tmp
, 0L);
1047 return GFC_DEP_NODEP
;
1050 #undef IS_CONSTANT_INTEGER
1052 /* Check for forward dependencies x:y vs. x+1:z. */
1053 if (l_dir
== 1 && r_dir
== 1
1054 && l_start
&& r_start
&& gfc_dep_compare_expr (l_start
, r_start
) == -1
1055 && l_end
&& r_end
&& gfc_dep_compare_expr (l_end
, r_end
) == -1)
1057 /* Check that the strides are the same. */
1058 if (!l_stride
&& !r_stride
)
1059 return GFC_DEP_FORWARD
;
1060 if (l_stride
&& r_stride
1061 && gfc_dep_compare_expr (l_stride
, r_stride
) == 0)
1062 return GFC_DEP_FORWARD
;
1065 /* Check for forward dependencies x:y:-1 vs. x-1:z:-1. */
1066 if (l_dir
== -1 && r_dir
== -1
1067 && l_start
&& r_start
&& gfc_dep_compare_expr (l_start
, r_start
) == 1
1068 && l_end
&& r_end
&& gfc_dep_compare_expr (l_end
, r_end
) == 1)
1070 /* Check that the strides are the same. */
1071 if (!l_stride
&& !r_stride
)
1072 return GFC_DEP_FORWARD
;
1073 if (l_stride
&& r_stride
1074 && gfc_dep_compare_expr (l_stride
, r_stride
) == 0)
1075 return GFC_DEP_FORWARD
;
1078 /* Check for backward dependencies:
1079 Are the strides the same?. */
1080 if ((!l_stride
&& !r_stride
)
1082 (l_stride
&& r_stride
1083 && gfc_dep_compare_expr (l_stride
, r_stride
) == 0))
1085 /* x:y vs. x+1:z. */
1086 if (l_dir
== 1 && r_dir
== 1
1087 && l_start
&& r_start
1088 && gfc_dep_compare_expr (l_start
, r_start
) == 1
1090 && gfc_dep_compare_expr (l_end
, r_end
) == 1)
1091 return GFC_DEP_BACKWARD
;
1093 /* x:y:-1 vs. x-1:z:-1. */
1094 if (l_dir
== -1 && r_dir
== -1
1095 && l_start
&& r_start
1096 && gfc_dep_compare_expr (l_start
, r_start
) == -1
1098 && gfc_dep_compare_expr (l_end
, r_end
) == -1)
1099 return GFC_DEP_BACKWARD
;
1102 return GFC_DEP_OVERLAP
;
1106 /* Determines overlapping for a single element and a section. */
1108 static gfc_dependency
1109 gfc_check_element_vs_section( gfc_ref
*lref
, gfc_ref
*rref
, int n
)
1118 elem
= lref
->u
.ar
.start
[n
];
1120 return GFC_DEP_OVERLAP
;
1123 start
= ref
->start
[n
] ;
1125 stride
= ref
->stride
[n
];
1127 if (!start
&& IS_ARRAY_EXPLICIT (ref
->as
))
1128 start
= ref
->as
->lower
[n
];
1129 if (!end
&& IS_ARRAY_EXPLICIT (ref
->as
))
1130 end
= ref
->as
->upper
[n
];
1132 /* Determine whether the stride is positive or negative. */
1135 else if (stride
->expr_type
== EXPR_CONSTANT
1136 && stride
->ts
.type
== BT_INTEGER
)
1137 s
= mpz_sgn (stride
->value
.integer
);
1141 /* Stride should never be zero. */
1143 return GFC_DEP_OVERLAP
;
1145 /* Positive strides. */
1148 /* Check for elem < lower. */
1149 if (start
&& gfc_dep_compare_expr (elem
, start
) == -1)
1150 return GFC_DEP_NODEP
;
1151 /* Check for elem > upper. */
1152 if (end
&& gfc_dep_compare_expr (elem
, end
) == 1)
1153 return GFC_DEP_NODEP
;
1157 s
= gfc_dep_compare_expr (start
, end
);
1158 /* Check for an empty range. */
1160 return GFC_DEP_NODEP
;
1161 if (s
== 0 && gfc_dep_compare_expr (elem
, start
) == 0)
1162 return GFC_DEP_EQUAL
;
1165 /* Negative strides. */
1168 /* Check for elem > upper. */
1169 if (end
&& gfc_dep_compare_expr (elem
, start
) == 1)
1170 return GFC_DEP_NODEP
;
1171 /* Check for elem < lower. */
1172 if (start
&& gfc_dep_compare_expr (elem
, end
) == -1)
1173 return GFC_DEP_NODEP
;
1177 s
= gfc_dep_compare_expr (start
, end
);
1178 /* Check for an empty range. */
1180 return GFC_DEP_NODEP
;
1181 if (s
== 0 && gfc_dep_compare_expr (elem
, start
) == 0)
1182 return GFC_DEP_EQUAL
;
1185 /* Unknown strides. */
1189 return GFC_DEP_OVERLAP
;
1190 s
= gfc_dep_compare_expr (start
, end
);
1192 return GFC_DEP_OVERLAP
;
1193 /* Assume positive stride. */
1196 /* Check for elem < lower. */
1197 if (gfc_dep_compare_expr (elem
, start
) == -1)
1198 return GFC_DEP_NODEP
;
1199 /* Check for elem > upper. */
1200 if (gfc_dep_compare_expr (elem
, end
) == 1)
1201 return GFC_DEP_NODEP
;
1203 /* Assume negative stride. */
1206 /* Check for elem > upper. */
1207 if (gfc_dep_compare_expr (elem
, start
) == 1)
1208 return GFC_DEP_NODEP
;
1209 /* Check for elem < lower. */
1210 if (gfc_dep_compare_expr (elem
, end
) == -1)
1211 return GFC_DEP_NODEP
;
1216 s
= gfc_dep_compare_expr (elem
, start
);
1218 return GFC_DEP_EQUAL
;
1219 if (s
== 1 || s
== -1)
1220 return GFC_DEP_NODEP
;
1224 return GFC_DEP_OVERLAP
;
1228 /* Traverse expr, checking all EXPR_VARIABLE symbols for their
1229 forall_index attribute. Return true if any variable may be
1230 being used as a FORALL index. Its safe to pessimistically
1231 return true, and assume a dependency. */
1234 contains_forall_index_p (gfc_expr
*expr
)
1236 gfc_actual_arglist
*arg
;
1244 switch (expr
->expr_type
)
1247 if (expr
->symtree
->n
.sym
->forall_index
)
1252 if (contains_forall_index_p (expr
->value
.op
.op1
)
1253 || contains_forall_index_p (expr
->value
.op
.op2
))
1258 for (arg
= expr
->value
.function
.actual
; arg
; arg
= arg
->next
)
1259 if (contains_forall_index_p (arg
->expr
))
1265 case EXPR_SUBSTRING
:
1268 case EXPR_STRUCTURE
:
1270 for (c
= gfc_constructor_first (expr
->value
.constructor
);
1271 c
; gfc_constructor_next (c
))
1272 if (contains_forall_index_p (c
->expr
))
1280 for (ref
= expr
->ref
; ref
; ref
= ref
->next
)
1284 for (i
= 0; i
< ref
->u
.ar
.dimen
; i
++)
1285 if (contains_forall_index_p (ref
->u
.ar
.start
[i
])
1286 || contains_forall_index_p (ref
->u
.ar
.end
[i
])
1287 || contains_forall_index_p (ref
->u
.ar
.stride
[i
]))
1295 if (contains_forall_index_p (ref
->u
.ss
.start
)
1296 || contains_forall_index_p (ref
->u
.ss
.end
))
1307 /* Determines overlapping for two single element array references. */
1309 static gfc_dependency
1310 gfc_check_element_vs_element (gfc_ref
*lref
, gfc_ref
*rref
, int n
)
1320 l_start
= l_ar
.start
[n
] ;
1321 r_start
= r_ar
.start
[n
] ;
1322 i
= gfc_dep_compare_expr (r_start
, l_start
);
1324 return GFC_DEP_EQUAL
;
1326 /* Treat two scalar variables as potentially equal. This allows
1327 us to prove that a(i,:) and a(j,:) have no dependency. See
1328 Gerald Roth, "Evaluation of Array Syntax Dependence Analysis",
1329 Proceedings of the International Conference on Parallel and
1330 Distributed Processing Techniques and Applications (PDPTA2001),
1331 Las Vegas, Nevada, June 2001. */
1332 /* However, we need to be careful when either scalar expression
1333 contains a FORALL index, as these can potentially change value
1334 during the scalarization/traversal of this array reference. */
1335 if (contains_forall_index_p (r_start
) || contains_forall_index_p (l_start
))
1336 return GFC_DEP_OVERLAP
;
1339 return GFC_DEP_NODEP
;
1340 return GFC_DEP_EQUAL
;
1344 /* Determine if an array ref, usually an array section specifies the
1345 entire array. In addition, if the second, pointer argument is
1346 provided, the function will return true if the reference is
1347 contiguous; eg. (:, 1) gives true but (1,:) gives false. */
1350 gfc_full_array_ref_p (gfc_ref
*ref
, bool *contiguous
)
1354 bool lbound_OK
= true;
1355 bool ubound_OK
= true;
1358 *contiguous
= false;
1360 if (ref
->type
!= REF_ARRAY
)
1363 if (ref
->u
.ar
.type
== AR_FULL
)
1370 if (ref
->u
.ar
.type
!= AR_SECTION
)
1375 for (i
= 0; i
< ref
->u
.ar
.dimen
; i
++)
1377 /* If we have a single element in the reference, for the reference
1378 to be full, we need to ascertain that the array has a single
1379 element in this dimension and that we actually reference the
1381 if (ref
->u
.ar
.dimen_type
[i
] == DIMEN_ELEMENT
)
1383 /* This is unconditionally a contiguous reference if all the
1384 remaining dimensions are elements. */
1388 for (n
= i
+ 1; n
< ref
->u
.ar
.dimen
; n
++)
1389 if (ref
->u
.ar
.dimen_type
[n
] != DIMEN_ELEMENT
)
1390 *contiguous
= false;
1394 || !ref
->u
.ar
.as
->lower
[i
]
1395 || !ref
->u
.ar
.as
->upper
[i
]
1396 || gfc_dep_compare_expr (ref
->u
.ar
.as
->lower
[i
],
1397 ref
->u
.ar
.as
->upper
[i
])
1398 || !ref
->u
.ar
.start
[i
]
1399 || gfc_dep_compare_expr (ref
->u
.ar
.start
[i
],
1400 ref
->u
.ar
.as
->lower
[i
]))
1406 /* Check the lower bound. */
1407 if (ref
->u
.ar
.start
[i
]
1409 || !ref
->u
.ar
.as
->lower
[i
]
1410 || gfc_dep_compare_expr (ref
->u
.ar
.start
[i
],
1411 ref
->u
.ar
.as
->lower
[i
])))
1413 /* Check the upper bound. */
1414 if (ref
->u
.ar
.end
[i
]
1416 || !ref
->u
.ar
.as
->upper
[i
]
1417 || gfc_dep_compare_expr (ref
->u
.ar
.end
[i
],
1418 ref
->u
.ar
.as
->upper
[i
])))
1420 /* Check the stride. */
1421 if (ref
->u
.ar
.stride
[i
]
1422 && !gfc_expr_is_one (ref
->u
.ar
.stride
[i
], 0))
1425 /* This is unconditionally a contiguous reference as long as all
1426 the subsequent dimensions are elements. */
1430 for (n
= i
+ 1; n
< ref
->u
.ar
.dimen
; n
++)
1431 if (ref
->u
.ar
.dimen_type
[n
] != DIMEN_ELEMENT
)
1432 *contiguous
= false;
1435 if (!lbound_OK
|| !ubound_OK
)
1442 /* Determine if a full array is the same as an array section with one
1443 variable limit. For this to be so, the strides must both be unity
1444 and one of either start == lower or end == upper must be true. */
1447 ref_same_as_full_array (gfc_ref
*full_ref
, gfc_ref
*ref
)
1450 bool upper_or_lower
;
1452 if (full_ref
->type
!= REF_ARRAY
)
1454 if (full_ref
->u
.ar
.type
!= AR_FULL
)
1456 if (ref
->type
!= REF_ARRAY
)
1458 if (ref
->u
.ar
.type
!= AR_SECTION
)
1461 for (i
= 0; i
< ref
->u
.ar
.dimen
; i
++)
1463 /* If we have a single element in the reference, we need to check
1464 that the array has a single element and that we actually reference
1465 the correct element. */
1466 if (ref
->u
.ar
.dimen_type
[i
] == DIMEN_ELEMENT
)
1468 if (!full_ref
->u
.ar
.as
1469 || !full_ref
->u
.ar
.as
->lower
[i
]
1470 || !full_ref
->u
.ar
.as
->upper
[i
]
1471 || gfc_dep_compare_expr (full_ref
->u
.ar
.as
->lower
[i
],
1472 full_ref
->u
.ar
.as
->upper
[i
])
1473 || !ref
->u
.ar
.start
[i
]
1474 || gfc_dep_compare_expr (ref
->u
.ar
.start
[i
],
1475 full_ref
->u
.ar
.as
->lower
[i
]))
1479 /* Check the strides. */
1480 if (full_ref
->u
.ar
.stride
[i
] && !gfc_expr_is_one (full_ref
->u
.ar
.stride
[i
], 0))
1482 if (ref
->u
.ar
.stride
[i
] && !gfc_expr_is_one (ref
->u
.ar
.stride
[i
], 0))
1485 upper_or_lower
= false;
1486 /* Check the lower bound. */
1487 if (ref
->u
.ar
.start
[i
]
1489 && full_ref
->u
.ar
.as
->lower
[i
]
1490 && gfc_dep_compare_expr (ref
->u
.ar
.start
[i
],
1491 full_ref
->u
.ar
.as
->lower
[i
]) == 0))
1492 upper_or_lower
= true;
1493 /* Check the upper bound. */
1494 if (ref
->u
.ar
.end
[i
]
1496 && full_ref
->u
.ar
.as
->upper
[i
]
1497 && gfc_dep_compare_expr (ref
->u
.ar
.end
[i
],
1498 full_ref
->u
.ar
.as
->upper
[i
]) == 0))
1499 upper_or_lower
= true;
1500 if (!upper_or_lower
)
1507 /* Finds if two array references are overlapping or not.
1509 2 : array references are overlapping but reversal of one or
1510 more dimensions will clear the dependency.
1511 1 : array references are overlapping.
1512 0 : array references are identical or not overlapping. */
1515 gfc_dep_resolver (gfc_ref
*lref
, gfc_ref
*rref
, gfc_reverse
*reverse
)
1518 gfc_dependency fin_dep
;
1519 gfc_dependency this_dep
;
1521 this_dep
= GFC_DEP_ERROR
;
1522 fin_dep
= GFC_DEP_ERROR
;
1523 /* Dependencies due to pointers should already have been identified.
1524 We only need to check for overlapping array references. */
1526 while (lref
&& rref
)
1528 /* We're resolving from the same base symbol, so both refs should be
1529 the same type. We traverse the reference chain until we find ranges
1530 that are not equal. */
1531 gcc_assert (lref
->type
== rref
->type
);
1535 /* The two ranges can't overlap if they are from different
1537 if (lref
->u
.c
.component
!= rref
->u
.c
.component
)
1542 /* Substring overlaps are handled by the string assignment code
1543 if there is not an underlying dependency. */
1544 return (fin_dep
== GFC_DEP_OVERLAP
) ? 1 : 0;
1548 if (ref_same_as_full_array (lref
, rref
))
1551 if (ref_same_as_full_array (rref
, lref
))
1554 if (lref
->u
.ar
.dimen
!= rref
->u
.ar
.dimen
)
1556 if (lref
->u
.ar
.type
== AR_FULL
)
1557 fin_dep
= gfc_full_array_ref_p (rref
, NULL
) ? GFC_DEP_EQUAL
1559 else if (rref
->u
.ar
.type
== AR_FULL
)
1560 fin_dep
= gfc_full_array_ref_p (lref
, NULL
) ? GFC_DEP_EQUAL
1567 for (n
=0; n
< lref
->u
.ar
.dimen
; n
++)
1569 /* Assume dependency when either of array reference is vector
1571 if (lref
->u
.ar
.dimen_type
[n
] == DIMEN_VECTOR
1572 || rref
->u
.ar
.dimen_type
[n
] == DIMEN_VECTOR
)
1575 if (lref
->u
.ar
.dimen_type
[n
] == DIMEN_RANGE
1576 && rref
->u
.ar
.dimen_type
[n
] == DIMEN_RANGE
)
1577 this_dep
= gfc_check_section_vs_section (lref
, rref
, n
);
1578 else if (lref
->u
.ar
.dimen_type
[n
] == DIMEN_ELEMENT
1579 && rref
->u
.ar
.dimen_type
[n
] == DIMEN_RANGE
)
1580 this_dep
= gfc_check_element_vs_section (lref
, rref
, n
);
1581 else if (rref
->u
.ar
.dimen_type
[n
] == DIMEN_ELEMENT
1582 && lref
->u
.ar
.dimen_type
[n
] == DIMEN_RANGE
)
1583 this_dep
= gfc_check_element_vs_section (rref
, lref
, n
);
1586 gcc_assert (rref
->u
.ar
.dimen_type
[n
] == DIMEN_ELEMENT
1587 && lref
->u
.ar
.dimen_type
[n
] == DIMEN_ELEMENT
);
1588 this_dep
= gfc_check_element_vs_element (rref
, lref
, n
);
1591 /* If any dimension doesn't overlap, we have no dependency. */
1592 if (this_dep
== GFC_DEP_NODEP
)
1595 /* Now deal with the loop reversal logic: This only works on
1596 ranges and is activated by setting
1597 reverse[n] == GFC_CAN_REVERSE
1598 The ability to reverse or not is set by previous conditions
1599 in this dimension. If reversal is not activated, the
1600 value GFC_DEP_BACKWARD is reset to GFC_DEP_OVERLAP. */
1601 if (rref
->u
.ar
.dimen_type
[n
] == DIMEN_RANGE
1602 && lref
->u
.ar
.dimen_type
[n
] == DIMEN_RANGE
)
1604 /* Set reverse if backward dependence and not inhibited. */
1605 if (reverse
&& reverse
[n
] != GFC_CANNOT_REVERSE
)
1606 reverse
[n
] = (this_dep
== GFC_DEP_BACKWARD
) ?
1607 GFC_REVERSE_SET
: reverse
[n
];
1609 /* Inhibit loop reversal if dependence not compatible. */
1610 if (reverse
&& reverse
[n
] != GFC_REVERSE_NOT_SET
1611 && this_dep
!= GFC_DEP_EQUAL
1612 && this_dep
!= GFC_DEP_BACKWARD
1613 && this_dep
!= GFC_DEP_NODEP
)
1615 reverse
[n
] = GFC_CANNOT_REVERSE
;
1616 if (this_dep
!= GFC_DEP_FORWARD
)
1617 this_dep
= GFC_DEP_OVERLAP
;
1620 /* If no intention of reversing or reversing is explicitly
1621 inhibited, convert backward dependence to overlap. */
1622 if ((reverse
== NULL
&& this_dep
== GFC_DEP_BACKWARD
)
1623 || (reverse
&& reverse
[n
] == GFC_CANNOT_REVERSE
))
1624 this_dep
= GFC_DEP_OVERLAP
;
1627 /* Overlap codes are in order of priority. We only need to
1628 know the worst one.*/
1629 if (this_dep
> fin_dep
)
1633 /* If this is an equal element, we have to keep going until we find
1634 the "real" array reference. */
1635 if (lref
->u
.ar
.type
== AR_ELEMENT
1636 && rref
->u
.ar
.type
== AR_ELEMENT
1637 && fin_dep
== GFC_DEP_EQUAL
)
1640 /* Exactly matching and forward overlapping ranges don't cause a
1642 if (fin_dep
< GFC_DEP_BACKWARD
)
1645 /* Keep checking. We only have a dependency if
1646 subsequent references also overlap. */
1656 /* If we haven't seen any array refs then something went wrong. */
1657 gcc_assert (fin_dep
!= GFC_DEP_ERROR
);
1659 /* Assume the worst if we nest to different depths. */
1663 return fin_dep
== GFC_DEP_OVERLAP
;