gcc/fortran/dependency.c

   1 /* Dependency analysis
   2    Copyright (C) 2000, 2001, 2002, 2005 Free Software Foundation, Inc.
   3    Contributed by Paul Brook <paul@nowt.org>
   4
   5 This file is part of GCC.
   6
   7 GCC is free software; you can redistribute it and/or modify it under
   8 the terms of the GNU General Public License as published by the Free
   9 Software Foundation; either version 2, or (at your option) any later
  10 version.
  11
  12 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
  13 WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15 for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with GCC; see the file COPYING.  If not, write to the Free
  19 Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
  20 02110-1301, USA.  */
  21
  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.  */
  26
  27
  28 #include "config.h"
  29 #include "gfortran.h"
  30 #include "dependency.h"
  31
  32 /* static declarations */
  33 /* Enums  */
  34 enum range {LHS, RHS, MID};
  35
  36 /* Dependency types.  These must be in reverse order of priority.  */
  37 typedef enum
  38 {
  39   GFC_DEP_ERROR,
  40   GFC_DEP_EQUAL,        /* Identical Ranges.  */
  41   GFC_DEP_FORWARD,      /* eg. a(1:3), a(2:4).  */
  42   GFC_DEP_OVERLAP,      /* May overlap in some other way.  */
  43   GFC_DEP_NODEP         /* Distinct ranges.  */
  44 }
  45 gfc_dependency;
  46
  47 /* Macros */
  48 #define IS_ARRAY_EXPLICIT(as) ((as->type == AS_EXPLICIT ? 1 : 0))
  49
  50
  51 /* Returns 1 if the expr is an integer constant value 1, 0 if it is not or
  52    def if the value could not be determined.  */
  53
  54 int
  55 gfc_expr_is_one (gfc_expr * expr, int def)
  56 {
  57   gcc_assert (expr != NULL);
  58
  59   if (expr->expr_type != EXPR_CONSTANT)
  60     return def;
  61
  62   if (expr->ts.type != BT_INTEGER)
  63     return def;
  64
  65   return mpz_cmp_si (expr->value.integer, 1) == 0;
  66 }
  67
  68
  69 /* Compare two values.  Returns 0 if e1 == e2, -1 if e1 < e2, +1 if e1 > e2,
  70    and -2 if the relationship could not be determined.  */
  71
  72 int
  73 gfc_dep_compare_expr (gfc_expr * e1, gfc_expr * e2)
  74 {
  75   int i;
  76
  77   if (e1->expr_type != e2->expr_type)
  78     return -2;
  79
  80   switch (e1->expr_type)
  81     {
  82     case EXPR_CONSTANT:
  83       if (e1->ts.type != BT_INTEGER || e2->ts.type != BT_INTEGER)
  84         return -2;
  85
  86       i = mpz_cmp (e1->value.integer, e2->value.integer);
  87       if (i == 0)
  88         return 0;
  89       else if (i < 0)
  90         return -1;
  91       return 1;
  92
  93     case EXPR_VARIABLE:
  94       if (e1->ref || e2->ref)
  95         return -2;
  96       if (e1->symtree->n.sym == e2->symtree->n.sym)
  97         return 0;
  98       return -2;
  99
 100     default:
 101       return -2;
 102     }
 103 }
 104
 105
 106 /* Returns 1 if the two ranges are the same, 0 if they are not, and def
 107    if the results are indeterminate.  N is the dimension to compare.  */
 108
 109 int
 110 gfc_is_same_range (gfc_array_ref * ar1, gfc_array_ref * ar2, int n, int def)
 111 {
 112   gfc_expr *e1;
 113   gfc_expr *e2;
 114   int i;
 115
 116   /* TODO: More sophisticated range comparison.  */
 117   gcc_assert (ar1 && ar2);
 118
 119   gcc_assert (ar1->dimen_type[n] == ar2->dimen_type[n]);
 120
 121   e1 = ar1->stride[n];
 122   e2 = ar2->stride[n];
 123   /* Check for mismatching strides.  A NULL stride means a stride of 1.  */
 124   if (e1 && !e2)
 125     {
 126       i = gfc_expr_is_one (e1, -1);
 127       if (i == -1)
 128         return def;
 129       else if (i == 0)
 130         return 0;
 131     }
 132   else if (e2 && !e1)
 133     {
 134       i = gfc_expr_is_one (e2, -1);
 135       if (i == -1)
 136         return def;
 137       else if (i == 0)
 138         return 0;
 139     }
 140   else if (e1 && e2)
 141     {
 142       i = gfc_dep_compare_expr (e1, e2);
 143       if (i == -2)
 144         return def;
 145       else if (i != 0)
 146         return 0;
 147     }
 148   /* The strides match.  */
 149
 150   /* Check the range start.  */
 151   e1 = ar1->start[n];
 152   e2 = ar2->start[n];
 153
 154   if (!(e1 || e2))
 155     return 1;
 156
 157   /* Use the bound of the array if no bound is specified.  */
 158   if (ar1->as && !e1)
 159     e1 = ar1->as->lower[n];
 160
 161   if (ar2->as && !e2)
 162     e2 = ar2->as->upper[n];
 163
 164   /* Check we have values for both.  */
 165   if (!(e1 && e2))
 166     return def;
 167
 168   i = gfc_dep_compare_expr (e1, e2);
 169
 170   if (i == -2)
 171     return def;
 172   else if (i == 0)
 173     return 1;
 174   return 0;
 175 }
 176
 177
 178 /* Some array-returning intrinsics can be implemented by reusing the
 179    data from one of the array arguments.  For example, TRANSPOSE does
 180    not necessarily need to allocate new data: it can be implemented
 181    by copying the original array's descriptor and simply swapping the
 182    two dimension specifications.
 183
 184    If EXPR is a call to such an intrinsic, return the argument
 185    whose data can be reused, otherwise return NULL.  */
 186
 187 gfc_expr *
 188 gfc_get_noncopying_intrinsic_argument (gfc_expr * expr)
 189 {
 190   if (expr->expr_type != EXPR_FUNCTION || !expr->value.function.isym)
 191     return NULL;
 192
 193   switch (expr->value.function.isym->generic_id)
 194     {
 195     case GFC_ISYM_TRANSPOSE:
 196       return expr->value.function.actual->expr;
 197
 198     default:
 199       return NULL;
 200     }
 201 }
 202
 203
 204 /* Return true if the result of reference REF can only be constructed
 205    using a temporary array.  */
 206
 207 bool
 208 gfc_ref_needs_temporary_p (gfc_ref *ref)
 209 {
 210   int n;
 211   bool subarray_p;
 212
 213   subarray_p = false;
 214   for (; ref; ref = ref->next)
 215     switch (ref->type)
 216       {
 217       case REF_ARRAY:
 218         /* Vector dimensions are generally not monotonic and must be
 219            handled using a temporary.  */
 220         if (ref->u.ar.type == AR_SECTION)
 221           for (n = 0; n < ref->u.ar.dimen; n++)
 222             if (ref->u.ar.dimen_type[n] == DIMEN_VECTOR)
 223               return true;
 224
 225         subarray_p = true;
 226         break;
 227
 228       case REF_SUBSTRING:
 229         /* Within an array reference, character substrings generally
 230            need a temporary.  Character array strides are expressed as
 231            multiples of the element size (consistent with other array
 232            types), not in characters.  */
 233         return subarray_p;
 234
 235       case REF_COMPONENT:
 236         break;
 237       }
 238
 239   return false;
 240 }
 241
 242
 243 /* Return true if array variable VAR could be passed to the same function
 244    as argument EXPR without interfering with EXPR.  INTENT is the intent
 245    of VAR.
 246
 247    This is considerably less conservative than other dependencies
 248    because many function arguments will already be copied into a
 249    temporary.  */
 250
 251 static int
 252 gfc_check_argument_var_dependency (gfc_expr * var, sym_intent intent,
 253                                    gfc_expr * expr)
 254 {
 255   gcc_assert (var->expr_type == EXPR_VARIABLE);
 256   gcc_assert (var->rank > 0);
 257
 258   switch (expr->expr_type)
 259     {
 260     case EXPR_VARIABLE:
 261       return (gfc_ref_needs_temporary_p (expr->ref)
 262               || gfc_check_dependency (var, expr, NULL, 0));
 263
 264     case EXPR_ARRAY:
 265       return gfc_check_dependency (var, expr, NULL, 0);
 266
 267     case EXPR_FUNCTION:
 268       if (intent != INTENT_IN && expr->inline_noncopying_intrinsic)
 269         {
 270           expr = gfc_get_noncopying_intrinsic_argument (expr);
 271           return gfc_check_argument_var_dependency (var, intent, expr);
 272         }
 273       return 0;
 274
 275     default:
 276       return 0;
 277     }
 278 }
 279
 280
 281 /* Like gfc_check_argument_var_dependency, but extended to any
 282    array expression OTHER, not just variables.  */
 283
 284 static int
 285 gfc_check_argument_dependency (gfc_expr * other, sym_intent intent,
 286                                gfc_expr * expr)
 287 {
 288   switch (other->expr_type)
 289     {
 290     case EXPR_VARIABLE:
 291       return gfc_check_argument_var_dependency (other, intent, expr);
 292
 293     case EXPR_FUNCTION:
 294       if (other->inline_noncopying_intrinsic)
 295         {
 296           other = gfc_get_noncopying_intrinsic_argument (other);
 297           return gfc_check_argument_dependency (other, INTENT_IN, expr);
 298         }
 299       return 0;
 300
 301     default:
 302       return 0;
 303     }
 304 }
 305
 306
 307 /* Like gfc_check_argument_dependency, but check all the arguments in ACTUAL.
 308    FNSYM is the function being called, or NULL if not known.  */
 309
 310 int
 311 gfc_check_fncall_dependency (gfc_expr * other, sym_intent intent,
 312                              gfc_symbol * fnsym, gfc_actual_arglist * actual)
 313 {
 314   gfc_formal_arglist *formal;
 315   gfc_expr *expr;
 316
 317   formal = fnsym ? fnsym->formal : NULL;
 318   for (; actual; actual = actual->next, formal = formal ? formal->next : NULL)
 319     {
 320       expr = actual->expr;
 321
 322       /* Skip args which are not present.  */
 323       if (!expr)
 324         continue;
 325
 326       /* Skip intent(in) arguments if OTHER itself is intent(in).  */
 327       if (formal
 328           && intent == INTENT_IN
 329           && formal->sym->attr.intent == INTENT_IN)
 330         continue;
 331
 332       if (gfc_check_argument_dependency (other, intent, expr))
 333         return 1;
 334     }
 335
 336   return 0;
 337 }
 338
 339
 340 /* Return true if the statement body redefines the condition.  Returns
 341    true if expr2 depends on expr1.  expr1 should be a single term
 342    suitable for the lhs of an assignment.  The symbols listed in VARS
 343    must be considered to have all possible values. All other scalar
 344    variables may be considered constant.  Used for forall and where
 345    statements.  Also used with functions returning arrays without a
 346    temporary.  */
 347
 348 int
 349 gfc_check_dependency (gfc_expr * expr1, gfc_expr * expr2, gfc_expr ** vars,
 350                       int nvars)
 351 {
 352   gfc_ref *ref;
 353   int n;
 354   gfc_actual_arglist *actual;
 355
 356   gcc_assert (expr1->expr_type == EXPR_VARIABLE);
 357
 358   /* TODO: -fassume-no-pointer-aliasing */
 359   if (expr1->symtree->n.sym->attr.pointer)
 360     return 1;
 361   for (ref = expr1->ref; ref; ref = ref->next)
 362     {
 363       if (ref->type == REF_COMPONENT && ref->u.c.component->pointer)
 364         return 1;
 365     }
 366
 367   switch (expr2->expr_type)
 368     {
 369     case EXPR_OP:
 370       n = gfc_check_dependency (expr1, expr2->value.op.op1, vars, nvars);
 371       if (n)
 372         return n;
 373       if (expr2->value.op.op2)
 374         return gfc_check_dependency (expr1, expr2->value.op.op2, vars, nvars);
 375       return 0;
 376
 377     case EXPR_VARIABLE:
 378       if (expr2->symtree->n.sym->attr.pointer)
 379         return 1;
 380
 381       for (ref = expr2->ref; ref; ref = ref->next)
 382         {
 383           if (ref->type == REF_COMPONENT && ref->u.c.component->pointer)
 384             return 1;
 385         }
 386
 387       if (expr1->symtree->n.sym != expr2->symtree->n.sym)
 388         return 0;
 389
 390       for (ref = expr2->ref; ref; ref = ref->next)
 391         {
 392           /* Identical ranges return 0, overlapping ranges return 1.  */
 393           if (ref->type == REF_ARRAY)
 394             return 1;
 395         }
 396       return 1;
 397
 398     case EXPR_FUNCTION:
 399       /* Remember possible differences between elemental and
 400          transformational functions.  All functions inside a FORALL
 401          will be pure.  */
 402       for (actual = expr2->value.function.actual;
 403            actual; actual = actual->next)
 404         {
 405           if (!actual->expr)
 406             continue;
 407           n = gfc_check_dependency (expr1, actual->expr, vars, nvars);
 408           if (n)
 409             return n;
 410         }
 411       return 0;
 412
 413     case EXPR_CONSTANT:
 414       return 0;
 415
 416     case EXPR_ARRAY:
 417       /* Probably ok in the majority of (constant) cases.  */
 418       return 1;
 419
 420     default:
 421       return 1;
 422     }
 423 }
 424
 425
 426 /* Calculates size of the array reference using lower bound, upper bound
 427    and stride.  */
 428
 429 static void
 430 get_no_of_elements(mpz_t ele, gfc_expr * u1, gfc_expr * l1, gfc_expr * s1)
 431 {
 432   /* nNoOfEle = (u1-l1)/s1  */
 433
 434   mpz_sub (ele, u1->value.integer, l1->value.integer);
 435
 436   if (s1 != NULL)
 437     mpz_tdiv_q (ele, ele, s1->value.integer);
 438 }
 439
 440
 441 /* Returns if the ranges ((0..Y), (X1..X2))  overlap.  */
 442
 443 static gfc_dependency
 444 get_deps (mpz_t x1, mpz_t x2, mpz_t y)
 445 {
 446   int start;
 447   int end;
 448
 449   start = mpz_cmp_ui (x1, 0);
 450   end = mpz_cmp (x2, y);
 451
 452   /* Both ranges the same.  */
 453   if (start == 0 && end == 0)
 454     return GFC_DEP_EQUAL;
 455
 456   /* Distinct ranges.  */
 457   if ((start < 0 && mpz_cmp_ui (x2, 0) < 0)
 458       || (mpz_cmp (x1, y) > 0 && end > 0))
 459     return GFC_DEP_NODEP;
 460
 461   /* Overlapping, but with corresponding elements of the second range
 462      greater than the first.  */
 463   if (start > 0 && end > 0)
 464     return GFC_DEP_FORWARD;
 465
 466   /* Overlapping in some other way.  */
 467   return GFC_DEP_OVERLAP;
 468 }
 469
 470
 471 /* Perform the same linear transformation on sections l and r such that
 472    (l_start:l_end:l_stride) -> (0:no_of_elements)
 473    (r_start:r_end:r_stride) -> (X1:X2)
 474    Where r_end is implicit as both sections must have the same number of
 475    elements.
 476    Returns 0 on success, 1 of the transformation failed.  */
 477 /* TODO: Should this be (0:no_of_elements-1) */
 478
 479 static int
 480 transform_sections (mpz_t X1, mpz_t X2, mpz_t no_of_elements,
 481                     gfc_expr * l_start, gfc_expr * l_end, gfc_expr * l_stride,
 482                     gfc_expr * r_start, gfc_expr * r_stride)
 483 {
 484   if (NULL == l_start || NULL == l_end || NULL == r_start)
 485     return 1;
 486
 487   /* TODO : Currently we check the dependency only when start, end and stride
 488     are constant.  We could also check for equal (variable) values, and
 489     common subexpressions, eg. x vs. x+1.  */
 490
 491   if (l_end->expr_type != EXPR_CONSTANT
 492       || l_start->expr_type != EXPR_CONSTANT
 493       || r_start->expr_type != EXPR_CONSTANT
 494       || ((NULL != l_stride) && (l_stride->expr_type != EXPR_CONSTANT))
 495       || ((NULL != r_stride) && (r_stride->expr_type != EXPR_CONSTANT)))
 496     {
 497        return 1;
 498     }
 499
 500
 501   get_no_of_elements (no_of_elements, l_end, l_start, l_stride);
 502
 503   mpz_sub (X1, r_start->value.integer, l_start->value.integer);
 504   if (l_stride != NULL)
 505     mpz_cdiv_q (X1, X1, l_stride->value.integer);
 506
 507   if (r_stride == NULL)
 508     mpz_set (X2, no_of_elements);
 509   else
 510     mpz_mul (X2, no_of_elements, r_stride->value.integer);
 511
 512   if (l_stride != NULL)
 513     mpz_cdiv_q (X2, X2, l_stride->value.integer);
 514   mpz_add (X2, X2, X1);
 515
 516   return 0;
 517 }
 518
 519
 520 /* Determines overlapping for two array sections.  */
 521
 522 static gfc_dependency
 523 gfc_check_section_vs_section (gfc_ref * lref, gfc_ref * rref, int n)
 524 {
 525   gfc_expr *l_start;
 526   gfc_expr *l_end;
 527   gfc_expr *l_stride;
 528
 529   gfc_expr *r_start;
 530   gfc_expr *r_stride;
 531
 532   gfc_array_ref l_ar;
 533   gfc_array_ref r_ar;
 534
 535   mpz_t no_of_elements;
 536   mpz_t X1, X2;
 537   gfc_dependency dep;
 538
 539   l_ar = lref->u.ar;
 540   r_ar = rref->u.ar;
 541
 542   l_start = l_ar.start[n];
 543   l_end = l_ar.end[n];
 544   l_stride = l_ar.stride[n];
 545   r_start = r_ar.start[n];
 546   r_stride = r_ar.stride[n];
 547
 548   /* if l_start is NULL take it from array specifier  */
 549   if (NULL == l_start && IS_ARRAY_EXPLICIT(l_ar.as))
 550     l_start = l_ar.as->lower[n];
 551
 552   /* if l_end is NULL take it from array specifier  */
 553   if (NULL == l_end && IS_ARRAY_EXPLICIT(l_ar.as))
 554     l_end = l_ar.as->upper[n];
 555
 556   /* if r_start is NULL take it from array specifier  */
 557   if (NULL == r_start && IS_ARRAY_EXPLICIT(r_ar.as))
 558     r_start = r_ar.as->lower[n];
 559
 560   mpz_init (X1);
 561   mpz_init (X2);
 562   mpz_init (no_of_elements);
 563
 564   if (transform_sections (X1, X2, no_of_elements,
 565                           l_start, l_end, l_stride,
 566                           r_start, r_stride))
 567     dep = GFC_DEP_OVERLAP;
 568   else
 569     dep =  get_deps (X1, X2, no_of_elements);
 570
 571   mpz_clear (no_of_elements);
 572   mpz_clear (X1);
 573   mpz_clear (X2);
 574   return dep;
 575 }
 576
 577
 578 /* Checks if the expr chk is inside the range left-right.
 579    Returns  GFC_DEP_NODEP if chk is outside the range,
 580    GFC_DEP_OVERLAP otherwise.
 581    Assumes left<=right.  */
 582
 583 static gfc_dependency
 584 gfc_is_inside_range (gfc_expr * chk, gfc_expr * left, gfc_expr * right)
 585 {
 586   int l;
 587   int r;
 588   int s;
 589
 590   s = gfc_dep_compare_expr (left, right);
 591   if (s == -2)
 592     return GFC_DEP_OVERLAP;
 593
 594   l = gfc_dep_compare_expr (chk, left);
 595   r = gfc_dep_compare_expr (chk, right);
 596
 597   /* Check for indeterminate relationships.  */
 598   if (l == -2 || r == -2 || s == -2)
 599     return GFC_DEP_OVERLAP;
 600
 601   if (s == 1)
 602     {
 603       /* When left>right we want to check for right <= chk <= left.  */
 604       if (l <= 0 || r >= 0)
 605         return GFC_DEP_OVERLAP;
 606     }
 607   else
 608     {
 609       /* Otherwise check for left <= chk <= right.  */
 610       if (l >= 0 || r <= 0)
 611         return GFC_DEP_OVERLAP;
 612     }
 613
 614   return GFC_DEP_NODEP;
 615 }
 616
 617
 618 /* Determines overlapping for a single element and a section.  */
 619
 620 static gfc_dependency
 621 gfc_check_element_vs_section( gfc_ref * lref, gfc_ref * rref, int n)
 622 {
 623   gfc_array_ref l_ar;
 624   gfc_array_ref r_ar;
 625   gfc_expr *l_start;
 626   gfc_expr *r_start;
 627   gfc_expr *r_end;
 628
 629   l_ar = lref->u.ar;
 630   r_ar = rref->u.ar;
 631   l_start = l_ar.start[n] ;
 632   r_start = r_ar.start[n] ;
 633   r_end = r_ar.end[n] ;
 634   if (NULL == r_start && IS_ARRAY_EXPLICIT (r_ar.as))
 635     r_start = r_ar.as->lower[n];
 636   if (NULL == r_end && IS_ARRAY_EXPLICIT (r_ar.as))
 637     r_end = r_ar.as->upper[n];
 638   if (NULL == r_start || NULL == r_end || l_start == NULL)
 639     return GFC_DEP_OVERLAP;
 640
 641   return gfc_is_inside_range (l_start, r_end, r_start);
 642 }
 643
 644
 645 /* Determines overlapping for two single element array references.  */
 646
 647 static gfc_dependency
 648 gfc_check_element_vs_element (gfc_ref * lref, gfc_ref * rref, int n)
 649 {
 650   gfc_array_ref l_ar;
 651   gfc_array_ref r_ar;
 652   gfc_expr *l_start;
 653   gfc_expr *r_start;
 654   gfc_dependency nIsDep;
 655
 656   if (lref->type == REF_ARRAY && rref->type == REF_ARRAY)
 657     {
 658       l_ar = lref->u.ar;
 659       r_ar = rref->u.ar;
 660       l_start = l_ar.start[n] ;
 661       r_start = r_ar.start[n] ;
 662       if (gfc_dep_compare_expr (r_start, l_start) == 0)
 663         nIsDep = GFC_DEP_EQUAL;
 664       else
 665         nIsDep = GFC_DEP_NODEP;
 666   }
 667   else
 668     nIsDep = GFC_DEP_NODEP;
 669
 670   return nIsDep;
 671 }
 672
 673
 674 /* Finds if two array references are overlapping or not.
 675    Return value
 676         1 : array references are overlapping.
 677         0 : array references are not overlapping.  */
 678
 679 int
 680 gfc_dep_resolver (gfc_ref * lref, gfc_ref * rref)
 681 {
 682   int n;
 683   gfc_dependency fin_dep;
 684   gfc_dependency this_dep;
 685
 686
 687   fin_dep = GFC_DEP_ERROR;
 688   /* Dependencies due to pointers should already have been identified.
 689      We only need to check for overlapping array references.  */
 690
 691   while (lref && rref)
 692     {
 693       /* We're resolving from the same base symbol, so both refs should be
 694          the same type.  We traverse the reference chain intil we find ranges
 695          that are not equal.  */
 696       gcc_assert (lref->type == rref->type);
 697       switch (lref->type)
 698         {
 699         case REF_COMPONENT:
 700           /* The two ranges can't overlap if they are from different
 701              components.  */
 702           if (lref->u.c.component != rref->u.c.component)
 703             return 0;
 704           break;
 705
 706         case REF_SUBSTRING:
 707           /* Substring overlaps are handled by the string assignment code.  */
 708           return 0;
 709
 710         case REF_ARRAY:
 711
 712           for (n=0; n < lref->u.ar.dimen; n++)
 713             {
 714               /* Assume dependency when either of array reference is vector
 715                  subscript.  */
 716               if (lref->u.ar.dimen_type[n] == DIMEN_VECTOR
 717                   || rref->u.ar.dimen_type[n] == DIMEN_VECTOR)
 718                 return 1;
 719               if (lref->u.ar.dimen_type[n] == DIMEN_RANGE
 720                   && rref->u.ar.dimen_type[n] == DIMEN_RANGE)
 721                 this_dep = gfc_check_section_vs_section (lref, rref, n);
 722               else if (lref->u.ar.dimen_type[n] == DIMEN_ELEMENT
 723                        && rref->u.ar.dimen_type[n] == DIMEN_RANGE)
 724                 this_dep = gfc_check_element_vs_section (lref, rref, n);
 725               else if (rref->u.ar.dimen_type[n] == DIMEN_ELEMENT
 726                        && lref->u.ar.dimen_type[n] == DIMEN_RANGE)
 727                 this_dep = gfc_check_element_vs_section (rref, lref, n);
 728               else
 729                 {
 730                   gcc_assert (rref->u.ar.dimen_type[n] == DIMEN_ELEMENT
 731                           && lref->u.ar.dimen_type[n] == DIMEN_ELEMENT);
 732                   this_dep = gfc_check_element_vs_element (rref, lref, n);
 733                 }
 734
 735               /* If any dimension doesn't overlap, we have no dependency.  */
 736               if (this_dep == GFC_DEP_NODEP)
 737                 return 0;
 738
 739               /* Overlap codes are in order of priority.  We only need to
 740                  know the worst one.*/
 741               if (this_dep > fin_dep)
 742                 fin_dep = this_dep;
 743             }
 744           /* Exactly matching and forward overlapping ranges don't cause a
 745              dependency.  */
 746           if (fin_dep < GFC_DEP_OVERLAP)
 747             return 0;
 748
 749           /* Keep checking.  We only have a dependency if
 750              subsequent references also overlap.  */
 751           break;
 752
 753         default:
 754           gcc_unreachable ();
 755         }
 756       lref = lref->next;
 757       rref = rref->next;
 758     }
 759
 760   /* If we haven't seen any array refs then something went wrong.  */
 761   gcc_assert (fin_dep != GFC_DEP_ERROR);
 762
 763   if (fin_dep < GFC_DEP_OVERLAP)
 764     return 0;
 765   else
 766     return 1;
 767 }
 768