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, 1));
 263
 264     case EXPR_ARRAY:
 265       return gfc_check_dependency (var, expr, 1);
 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 IDENTICAL flag indicates
 343    whether array references to the same symbol with identical range
 344    references count as a dependency or not.  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, bool identical)
 350 {
 351   gfc_ref *ref;
 352   int n;
 353   gfc_actual_arglist *actual;
 354
 355   gcc_assert (expr1->expr_type == EXPR_VARIABLE);
 356
 357   /* TODO: -fassume-no-pointer-aliasing */
 358   if (expr1->symtree->n.sym->attr.pointer)
 359     return 1;
 360   for (ref = expr1->ref; ref; ref = ref->next)
 361     {
 362       if (ref->type == REF_COMPONENT && ref->u.c.component->pointer)
 363         return 1;
 364     }
 365
 366   switch (expr2->expr_type)
 367     {
 368     case EXPR_OP:
 369       n = gfc_check_dependency (expr1, expr2->value.op.op1, identical);
 370       if (n)
 371         return n;
 372       if (expr2->value.op.op2)
 373         return gfc_check_dependency (expr1, expr2->value.op.op2, identical);
 374       return 0;
 375
 376     case EXPR_VARIABLE:
 377       if (expr2->symtree->n.sym->attr.pointer)
 378         return 1;
 379
 380       for (ref = expr2->ref; ref; ref = ref->next)
 381         {
 382           if (ref->type == REF_COMPONENT && ref->u.c.component->pointer)
 383             return 1;
 384         }
 385
 386       if (expr1->symtree->n.sym != expr2->symtree->n.sym)
 387         return 0;
 388
 389       if (identical)
 390         return 1;
 391
 392       /* Identical ranges return 0, overlapping ranges return 1.  */
 393
 394       /* Return zero if we refer to the same full arrays.  */
 395       if (expr1->ref->type == REF_ARRAY
 396           && expr2->ref->type == REF_ARRAY
 397           && expr1->ref->u.ar.type == AR_FULL
 398           && expr2->ref->u.ar.type == AR_FULL
 399           && !expr1->ref->next
 400           && !expr2->ref->next)
 401         return 0;
 402
 403       return 1;
 404
 405     case EXPR_FUNCTION:
 406       if (expr2->inline_noncopying_intrinsic)
 407         identical = 1;
 408       /* Remember possible differences between elemental and
 409          transformational functions.  All functions inside a FORALL
 410          will be pure.  */
 411       for (actual = expr2->value.function.actual;
 412            actual; actual = actual->next)
 413         {
 414           if (!actual->expr)
 415             continue;
 416           n = gfc_check_dependency (expr1, actual->expr, identical);
 417           if (n)
 418             return n;
 419         }
 420       return 0;
 421
 422     case EXPR_CONSTANT:
 423       return 0;
 424
 425     case EXPR_ARRAY:
 426       /* Probably ok in the majority of (constant) cases.  */
 427       return 1;
 428
 429     default:
 430       return 1;
 431     }
 432 }
 433
 434
 435 /* Calculates size of the array reference using lower bound, upper bound
 436    and stride.  */
 437
 438 static void
 439 get_no_of_elements(mpz_t ele, gfc_expr * u1, gfc_expr * l1, gfc_expr * s1)
 440 {
 441   /* nNoOfEle = (u1-l1)/s1  */
 442
 443   mpz_sub (ele, u1->value.integer, l1->value.integer);
 444
 445   if (s1 != NULL)
 446     mpz_tdiv_q (ele, ele, s1->value.integer);
 447 }
 448
 449
 450 /* Returns if the ranges ((0..Y), (X1..X2))  overlap.  */
 451
 452 static gfc_dependency
 453 get_deps (mpz_t x1, mpz_t x2, mpz_t y)
 454 {
 455   int start;
 456   int end;
 457
 458   start = mpz_cmp_ui (x1, 0);
 459   end = mpz_cmp (x2, y);
 460
 461   /* Both ranges the same.  */
 462   if (start == 0 && end == 0)
 463     return GFC_DEP_EQUAL;
 464
 465   /* Distinct ranges.  */
 466   if ((start < 0 && mpz_cmp_ui (x2, 0) < 0)
 467       || (mpz_cmp (x1, y) > 0 && end > 0))
 468     return GFC_DEP_NODEP;
 469
 470   /* Overlapping, but with corresponding elements of the second range
 471      greater than the first.  */
 472   if (start > 0 && end > 0)
 473     return GFC_DEP_FORWARD;
 474
 475   /* Overlapping in some other way.  */
 476   return GFC_DEP_OVERLAP;
 477 }
 478
 479
 480 /* Perform the same linear transformation on sections l and r such that
 481    (l_start:l_end:l_stride) -> (0:no_of_elements)
 482    (r_start:r_end:r_stride) -> (X1:X2)
 483    Where r_end is implicit as both sections must have the same number of
 484    elements.
 485    Returns 0 on success, 1 of the transformation failed.  */
 486 /* TODO: Should this be (0:no_of_elements-1) */
 487
 488 static int
 489 transform_sections (mpz_t X1, mpz_t X2, mpz_t no_of_elements,
 490                     gfc_expr * l_start, gfc_expr * l_end, gfc_expr * l_stride,
 491                     gfc_expr * r_start, gfc_expr * r_stride)
 492 {
 493   if (NULL == l_start || NULL == l_end || NULL == r_start)
 494     return 1;
 495
 496   /* TODO : Currently we check the dependency only when start, end and stride
 497     are constant.  We could also check for equal (variable) values, and
 498     common subexpressions, eg. x vs. x+1.  */
 499
 500   if (l_end->expr_type != EXPR_CONSTANT
 501       || l_start->expr_type != EXPR_CONSTANT
 502       || r_start->expr_type != EXPR_CONSTANT
 503       || ((NULL != l_stride) && (l_stride->expr_type != EXPR_CONSTANT))
 504       || ((NULL != r_stride) && (r_stride->expr_type != EXPR_CONSTANT)))
 505     {
 506        return 1;
 507     }
 508
 509
 510   get_no_of_elements (no_of_elements, l_end, l_start, l_stride);
 511
 512   mpz_sub (X1, r_start->value.integer, l_start->value.integer);
 513   if (l_stride != NULL)
 514     mpz_cdiv_q (X1, X1, l_stride->value.integer);
 515
 516   if (r_stride == NULL)
 517     mpz_set (X2, no_of_elements);
 518   else
 519     mpz_mul (X2, no_of_elements, r_stride->value.integer);
 520
 521   if (l_stride != NULL)
 522     mpz_cdiv_q (X2, X2, l_stride->value.integer);
 523   mpz_add (X2, X2, X1);
 524
 525   return 0;
 526 }
 527
 528
 529 /* Determines overlapping for two array sections.  */
 530
 531 static gfc_dependency
 532 gfc_check_section_vs_section (gfc_ref * lref, gfc_ref * rref, int n)
 533 {
 534   gfc_expr *l_start;
 535   gfc_expr *l_end;
 536   gfc_expr *l_stride;
 537
 538   gfc_expr *r_start;
 539   gfc_expr *r_stride;
 540
 541   gfc_array_ref l_ar;
 542   gfc_array_ref r_ar;
 543
 544   mpz_t no_of_elements;
 545   mpz_t X1, X2;
 546   gfc_dependency dep;
 547
 548   l_ar = lref->u.ar;
 549   r_ar = rref->u.ar;
 550
 551   l_start = l_ar.start[n];
 552   l_end = l_ar.end[n];
 553   l_stride = l_ar.stride[n];
 554   r_start = r_ar.start[n];
 555   r_stride = r_ar.stride[n];
 556
 557   /* if l_start is NULL take it from array specifier  */
 558   if (NULL == l_start && IS_ARRAY_EXPLICIT(l_ar.as))
 559     l_start = l_ar.as->lower[n];
 560
 561   /* if l_end is NULL take it from array specifier  */
 562   if (NULL == l_end && IS_ARRAY_EXPLICIT(l_ar.as))
 563     l_end = l_ar.as->upper[n];
 564
 565   /* if r_start is NULL take it from array specifier  */
 566   if (NULL == r_start && IS_ARRAY_EXPLICIT(r_ar.as))
 567     r_start = r_ar.as->lower[n];
 568
 569   mpz_init (X1);
 570   mpz_init (X2);
 571   mpz_init (no_of_elements);
 572
 573   if (transform_sections (X1, X2, no_of_elements,
 574                           l_start, l_end, l_stride,
 575                           r_start, r_stride))
 576     dep = GFC_DEP_OVERLAP;
 577   else
 578     dep =  get_deps (X1, X2, no_of_elements);
 579
 580   mpz_clear (no_of_elements);
 581   mpz_clear (X1);
 582   mpz_clear (X2);
 583   return dep;
 584 }
 585
 586
 587 /* Checks if the expr chk is inside the range left-right.
 588    Returns  GFC_DEP_NODEP if chk is outside the range,
 589    GFC_DEP_OVERLAP otherwise.
 590    Assumes left<=right.  */
 591
 592 static gfc_dependency
 593 gfc_is_inside_range (gfc_expr * chk, gfc_expr * left, gfc_expr * right)
 594 {
 595   int l;
 596   int r;
 597   int s;
 598
 599   s = gfc_dep_compare_expr (left, right);
 600   if (s == -2)
 601     return GFC_DEP_OVERLAP;
 602
 603   l = gfc_dep_compare_expr (chk, left);
 604   r = gfc_dep_compare_expr (chk, right);
 605
 606   /* Check for indeterminate relationships.  */
 607   if (l == -2 || r == -2 || s == -2)
 608     return GFC_DEP_OVERLAP;
 609
 610   if (s == 1)
 611     {
 612       /* When left>right we want to check for right <= chk <= left.  */
 613       if (l <= 0 || r >= 0)
 614         return GFC_DEP_OVERLAP;
 615     }
 616   else
 617     {
 618       /* Otherwise check for left <= chk <= right.  */
 619       if (l >= 0 || r <= 0)
 620         return GFC_DEP_OVERLAP;
 621     }
 622
 623   return GFC_DEP_NODEP;
 624 }
 625
 626
 627 /* Determines overlapping for a single element and a section.  */
 628
 629 static gfc_dependency
 630 gfc_check_element_vs_section( gfc_ref * lref, gfc_ref * rref, int n)
 631 {
 632   gfc_array_ref l_ar;
 633   gfc_array_ref r_ar;
 634   gfc_expr *l_start;
 635   gfc_expr *r_start;
 636   gfc_expr *r_end;
 637
 638   l_ar = lref->u.ar;
 639   r_ar = rref->u.ar;
 640   l_start = l_ar.start[n] ;
 641   r_start = r_ar.start[n] ;
 642   r_end = r_ar.end[n] ;
 643   if (NULL == r_start && IS_ARRAY_EXPLICIT (r_ar.as))
 644     r_start = r_ar.as->lower[n];
 645   if (NULL == r_end && IS_ARRAY_EXPLICIT (r_ar.as))
 646     r_end = r_ar.as->upper[n];
 647   if (NULL == r_start || NULL == r_end || l_start == NULL)
 648     return GFC_DEP_OVERLAP;
 649
 650   return gfc_is_inside_range (l_start, r_end, r_start);
 651 }
 652
 653
 654 /* Determines overlapping for two single element array references.  */
 655
 656 static gfc_dependency
 657 gfc_check_element_vs_element (gfc_ref * lref, gfc_ref * rref, int n)
 658 {
 659   gfc_array_ref l_ar;
 660   gfc_array_ref r_ar;
 661   gfc_expr *l_start;
 662   gfc_expr *r_start;
 663   gfc_dependency nIsDep;
 664
 665   if (lref->type == REF_ARRAY && rref->type == REF_ARRAY)
 666     {
 667       l_ar = lref->u.ar;
 668       r_ar = rref->u.ar;
 669       l_start = l_ar.start[n] ;
 670       r_start = r_ar.start[n] ;
 671       if (gfc_dep_compare_expr (r_start, l_start) == 0)
 672         nIsDep = GFC_DEP_EQUAL;
 673       else
 674         nIsDep = GFC_DEP_NODEP;
 675   }
 676   else
 677     nIsDep = GFC_DEP_NODEP;
 678
 679   return nIsDep;
 680 }
 681
 682
 683 /* Finds if two array references are overlapping or not.
 684    Return value
 685         1 : array references are overlapping.
 686         0 : array references are not overlapping.  */
 687
 688 int
 689 gfc_dep_resolver (gfc_ref * lref, gfc_ref * rref)
 690 {
 691   int n;
 692   gfc_dependency fin_dep;
 693   gfc_dependency this_dep;
 694
 695
 696   fin_dep = GFC_DEP_ERROR;
 697   /* Dependencies due to pointers should already have been identified.
 698      We only need to check for overlapping array references.  */
 699
 700   while (lref && rref)
 701     {
 702       /* We're resolving from the same base symbol, so both refs should be
 703          the same type.  We traverse the reference chain intil we find ranges
 704          that are not equal.  */
 705       gcc_assert (lref->type == rref->type);
 706       switch (lref->type)
 707         {
 708         case REF_COMPONENT:
 709           /* The two ranges can't overlap if they are from different
 710              components.  */
 711           if (lref->u.c.component != rref->u.c.component)
 712             return 0;
 713           break;
 714
 715         case REF_SUBSTRING:
 716           /* Substring overlaps are handled by the string assignment code.  */
 717           return 0;
 718
 719         case REF_ARRAY:
 720
 721           for (n=0; n < lref->u.ar.dimen; n++)
 722             {
 723               /* Assume dependency when either of array reference is vector
 724                  subscript.  */
 725               if (lref->u.ar.dimen_type[n] == DIMEN_VECTOR
 726                   || rref->u.ar.dimen_type[n] == DIMEN_VECTOR)
 727                 return 1;
 728               if (lref->u.ar.dimen_type[n] == DIMEN_RANGE
 729                   && rref->u.ar.dimen_type[n] == DIMEN_RANGE)
 730                 this_dep = gfc_check_section_vs_section (lref, rref, n);
 731               else if (lref->u.ar.dimen_type[n] == DIMEN_ELEMENT
 732                        && rref->u.ar.dimen_type[n] == DIMEN_RANGE)
 733                 this_dep = gfc_check_element_vs_section (lref, rref, n);
 734               else if (rref->u.ar.dimen_type[n] == DIMEN_ELEMENT
 735                        && lref->u.ar.dimen_type[n] == DIMEN_RANGE)
 736                 this_dep = gfc_check_element_vs_section (rref, lref, n);
 737               else
 738                 {
 739                   gcc_assert (rref->u.ar.dimen_type[n] == DIMEN_ELEMENT
 740                           && lref->u.ar.dimen_type[n] == DIMEN_ELEMENT);
 741                   this_dep = gfc_check_element_vs_element (rref, lref, n);
 742                 }
 743
 744               /* If any dimension doesn't overlap, we have no dependency.  */
 745               if (this_dep == GFC_DEP_NODEP)
 746                 return 0;
 747
 748               /* Overlap codes are in order of priority.  We only need to
 749                  know the worst one.*/
 750               if (this_dep > fin_dep)
 751                 fin_dep = this_dep;
 752             }
 753           /* Exactly matching and forward overlapping ranges don't cause a
 754              dependency.  */
 755           if (fin_dep < GFC_DEP_OVERLAP)
 756             return 0;
 757
 758           /* Keep checking.  We only have a dependency if
 759              subsequent references also overlap.  */
 760           break;
 761
 762         default:
 763           gcc_unreachable ();
 764         }
 765       lref = lref->next;
 766       rref = rref->next;
 767     }
 768
 769   /* If we haven't seen any array refs then something went wrong.  */
 770   gcc_assert (fin_dep != GFC_DEP_ERROR);
 771
 772   if (fin_dep < GFC_DEP_OVERLAP)
 773     return 0;
 774   else
 775     return 1;
 776 }
 777