LCOV - code coverage report
Current view: top level - gcc/fortran - dependency.cc (source / functions) Coverage Total Hit
Test: gcc.info Lines: 92.1 % 906 834
Test Date: 2023-09-09 13:19:57 Functions: 96.2 % 26 25
Legend: Lines: hit not hit | Branches: + taken - not taken # not executed Branches: - 0 0

             Branch data     Line data    Source code
       1                 :             : /* Dependency analysis
       2                 :             :    Copyright (C) 2000-2023 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 3, 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 COPYING3.  If not see
      19                 :             : <http://www.gnu.org/licenses/>.  */
      20                 :             : 
      21                 :             : /* dependency.cc -- Expression dependency analysis code.  */
      22                 :             : /* There's probably quite a bit of duplication in this file.  We currently
      23                 :             :    have different dependency checking functions for different types
      24                 :             :    if dependencies.  Ideally these would probably be merged.  */
      25                 :             : 
      26                 :             : #include "config.h"
      27                 :             : #include "system.h"
      28                 :             : #include "coretypes.h"
      29                 :             : #include "gfortran.h"
      30                 :             : #include "dependency.h"
      31                 :             : #include "constructor.h"
      32                 :             : #include "arith.h"
      33                 :             : #include "options.h"
      34                 :             : 
      35                 :             : /* static declarations */
      36                 :             : /* Enums  */
      37                 :             : enum range {LHS, RHS, MID};
      38                 :             : 
      39                 :             : /* Dependency types.  These must be in reverse order of priority.  */
      40                 :             : enum gfc_dependency
      41                 :             : {
      42                 :             :   GFC_DEP_ERROR,
      43                 :             :   GFC_DEP_EQUAL,        /* Identical Ranges.  */
      44                 :             :   GFC_DEP_FORWARD,      /* e.g., a(1:3) = a(2:4).  */
      45                 :             :   GFC_DEP_BACKWARD,     /* e.g. a(2:4) = a(1:3).  */
      46                 :             :   GFC_DEP_OVERLAP,      /* May overlap in some other way.  */
      47                 :             :   GFC_DEP_NODEP         /* Distinct ranges.  */
      48                 :             : };
      49                 :             : 
      50                 :             : /* Macros */
      51                 :             : #define IS_ARRAY_EXPLICIT(as) ((as->type == AS_EXPLICIT ? 1 : 0))
      52                 :             : 
      53                 :             : /* Forward declarations */
      54                 :             : 
      55                 :             : static gfc_dependency check_section_vs_section (gfc_array_ref *,
      56                 :             :                                                 gfc_array_ref *, int);
      57                 :             : 
      58                 :             : /* Returns 1 if the expr is an integer constant value 1, 0 if it is not or
      59                 :             :    def if the value could not be determined.  */
      60                 :             : 
      61                 :             : int
      62                 :        2988 : gfc_expr_is_one (gfc_expr *expr, int def)
      63                 :             : {
      64                 :        2988 :   gcc_assert (expr != NULL);
      65                 :             : 
      66                 :        2988 :   if (expr->expr_type != EXPR_CONSTANT)
      67                 :             :     return def;
      68                 :             : 
      69                 :        2625 :   if (expr->ts.type != BT_INTEGER)
      70                 :             :     return def;
      71                 :             : 
      72                 :        2625 :   return mpz_cmp_si (expr->value.integer, 1) == 0;
      73                 :             : }
      74                 :             : 
      75                 :             : /* Check if two array references are known to be identical.  Calls
      76                 :             :    gfc_dep_compare_expr if necessary for comparing array indices.  */
      77                 :             : 
      78                 :             : static bool
      79                 :        1871 : identical_array_ref (gfc_array_ref *a1, gfc_array_ref *a2)
      80                 :             : {
      81                 :        1871 :   int i;
      82                 :             : 
      83                 :        1871 :   if (a1->type == AR_FULL && a2->type == AR_FULL)
      84                 :             :     return true;
      85                 :             : 
      86                 :         475 :   if (a1->type == AR_SECTION && a2->type == AR_SECTION)
      87                 :             :     {
      88                 :          83 :       gcc_assert (a1->dimen == a2->dimen);
      89                 :             : 
      90                 :         161 :       for ( i = 0; i < a1->dimen; i++)
      91                 :             :         {
      92                 :             :           /* TODO: Currently, we punt on an integer array as an index.  */
      93                 :         119 :           if (a1->dimen_type[i] != DIMEN_RANGE
      94                 :         101 :               || a2->dimen_type[i] != DIMEN_RANGE)
      95                 :             :             return false;
      96                 :             : 
      97                 :         101 :           if (check_section_vs_section (a1, a2, i) != GFC_DEP_EQUAL)
      98                 :             :             return false;
      99                 :             :         }
     100                 :             :       return true;
     101                 :             :     }
     102                 :             : 
     103                 :         392 :   if (a1->type == AR_ELEMENT && a2->type == AR_ELEMENT)
     104                 :             :     {
     105                 :         368 :       if (a1->dimen != a2->dimen)
     106                 :           0 :         gfc_internal_error ("identical_array_ref(): inconsistent dimensions");
     107                 :             : 
     108                 :         517 :       for (i = 0; i < a1->dimen; i++)
     109                 :             :         {
     110                 :         384 :           if (gfc_dep_compare_expr (a1->start[i], a2->start[i]) != 0)
     111                 :             :             return false;
     112                 :             :         }
     113                 :             :       return true;
     114                 :             :     }
     115                 :             :   return false;
     116                 :             : }
     117                 :             : 
     118                 :             : 
     119                 :             : 
     120                 :             : /* Return true for identical variables, checking for references if
     121                 :             :    necessary.  Calls identical_array_ref for checking array sections.  */
     122                 :             : 
     123                 :             : static bool
     124                 :       29672 : are_identical_variables (gfc_expr *e1, gfc_expr *e2)
     125                 :             : {
     126                 :       29672 :   gfc_ref *r1, *r2;
     127                 :             : 
     128                 :       29672 :   if (e1->symtree->n.sym->attr.dummy && e2->symtree->n.sym->attr.dummy)
     129                 :             :     {
     130                 :             :       /* Dummy arguments: Only check for equal names.  */
     131                 :        8027 :       if (e1->symtree->n.sym->name != e2->symtree->n.sym->name)
     132                 :             :         return false;
     133                 :             :     }
     134                 :             :   else
     135                 :             :     {
     136                 :             :       /* Check for equal symbols.  */
     137                 :       21645 :       if (e1->symtree->n.sym != e2->symtree->n.sym)
     138                 :             :         return false;
     139                 :             :     }
     140                 :             : 
     141                 :             :   /* Volatile variables should never compare equal to themselves.  */
     142                 :             : 
     143                 :       10764 :   if (e1->symtree->n.sym->attr.volatile_)
     144                 :             :     return false;
     145                 :             : 
     146                 :       10563 :   r1 = e1->ref;
     147                 :       10563 :   r2 = e2->ref;
     148                 :             : 
     149                 :       12420 :   while (r1 != NULL || r2 != NULL)
     150                 :             :     {
     151                 :             : 
     152                 :             :       /* Assume the variables are not equal if one has a reference and the
     153                 :             :          other doesn't.
     154                 :             :          TODO: Handle full references like comparing a(:) to a.
     155                 :             :       */
     156                 :             : 
     157                 :        2610 :       if (r1 == NULL || r2 == NULL)
     158                 :             :         return false;
     159                 :             : 
     160                 :        2558 :       if (r1->type != r2->type)
     161                 :             :         return false;
     162                 :             : 
     163                 :        2516 :       switch (r1->type)
     164                 :             :         {
     165                 :             : 
     166                 :        1871 :         case REF_ARRAY:
     167                 :        1871 :           if (!identical_array_ref (&r1->u.ar,  &r2->u.ar))
     168                 :             :             return false;
     169                 :             : 
     170                 :             :           break;
     171                 :             : 
     172                 :         524 :         case REF_COMPONENT:
     173                 :         524 :           if (r1->u.c.component != r2->u.c.component)
     174                 :             :             return false;
     175                 :             :           break;
     176                 :             : 
     177                 :         121 :         case REF_SUBSTRING:
     178                 :         121 :           if (gfc_dep_compare_expr (r1->u.ss.start, r2->u.ss.start) != 0)
     179                 :             :             return false;
     180                 :             : 
     181                 :             :           /* If both are NULL, the end length compares equal, because we
     182                 :             :              are looking at the same variable. This can only happen for
     183                 :             :              assumed- or deferred-length character arguments.  */
     184                 :             : 
     185                 :          71 :           if (r1->u.ss.end == NULL && r2->u.ss.end == NULL)
     186                 :             :             break;
     187                 :             : 
     188                 :          70 :           if (gfc_dep_compare_expr (r1->u.ss.end, r2->u.ss.end) != 0)
     189                 :             :             return false;
     190                 :             : 
     191                 :             :           break;
     192                 :             : 
     193                 :           0 :         case REF_INQUIRY:
     194                 :           0 :           if (r1->u.i != r2->u.i)
     195                 :             :             return false;
     196                 :             :           break;
     197                 :             : 
     198                 :           0 :         default:
     199                 :           0 :           gfc_internal_error ("are_identical_variables: Bad type");
     200                 :             :         }
     201                 :        1857 :       r1 = r1->next;
     202                 :        1857 :       r2 = r2->next;
     203                 :             :     }
     204                 :             :   return true;
     205                 :             : }
     206                 :             : 
     207                 :             : /* Compare two functions for equality.  Returns 0 if e1==e2, -2 otherwise.  If
     208                 :             :    impure_ok is false, only return 0 for pure functions.  */
     209                 :             : 
     210                 :             : int
     211                 :       28304 : gfc_dep_compare_functions (gfc_expr *e1, gfc_expr *e2, bool impure_ok)
     212                 :             : {
     213                 :             : 
     214                 :       28304 :   gfc_actual_arglist *args1;
     215                 :       28304 :   gfc_actual_arglist *args2;
     216                 :             : 
     217                 :       28304 :   if (e1->expr_type != EXPR_FUNCTION || e2->expr_type != EXPR_FUNCTION)
     218                 :             :     return -2;
     219                 :             : 
     220                 :       27850 :   if ((e1->value.function.esym && e2->value.function.esym
     221                 :        2765 :        && e1->value.function.esym == e2->value.function.esym
     222                 :         558 :        && (e1->value.function.esym->result->attr.pure || impure_ok))
     223                 :       27439 :        || (e1->value.function.isym && e2->value.function.isym
     224                 :       23424 :            && e1->value.function.isym == e2->value.function.isym
     225                 :        9555 :            && (e1->value.function.isym->pure || impure_ok)))
     226                 :             :     {
     227                 :        9931 :       args1 = e1->value.function.actual;
     228                 :        9931 :       args2 = e2->value.function.actual;
     229                 :             : 
     230                 :             :       /* Compare the argument lists for equality.  */
     231                 :       12595 :       while (args1 && args2)
     232                 :             :         {
     233                 :             :           /*  Bitwise xor, since C has no non-bitwise xor operator.  */
     234                 :       11537 :           if ((args1->expr == NULL) ^ (args2->expr == NULL))
     235                 :             :             return -2;
     236                 :             : 
     237                 :       11380 :           if (args1->expr != NULL && args2->expr != NULL)
     238                 :             :             {
     239                 :       10707 :               gfc_expr *e1, *e2;
     240                 :       10707 :               e1 = args1->expr;
     241                 :       10707 :               e2 = args2->expr;
     242                 :             : 
     243                 :       10707 :               if (gfc_dep_compare_expr (e1, e2) != 0)
     244                 :             :                 return -2;
     245                 :             : 
     246                 :             :               /* Special case: String arguments which compare equal can have
     247                 :             :                  different lengths, which makes them different in calls to
     248                 :             :                  procedures.  */
     249                 :             : 
     250                 :        1997 :               if (e1->expr_type == EXPR_CONSTANT
     251                 :         259 :                   && e1->ts.type == BT_CHARACTER
     252                 :           7 :                   && e2->expr_type == EXPR_CONSTANT
     253                 :           7 :                   && e2->ts.type == BT_CHARACTER
     254                 :           7 :                   && e1->value.character.length != e2->value.character.length)
     255                 :             :                 return -2;
     256                 :             :             }
     257                 :             : 
     258                 :        2664 :           args1 = args1->next;
     259                 :        2664 :           args2 = args2->next;
     260                 :             :         }
     261                 :        2116 :       return (args1 || args2) ? -2 : 0;
     262                 :             :     }
     263                 :             :       else
     264                 :             :         return -2;
     265                 :             : }
     266                 :             : 
     267                 :             : /* Helper function to look through parens, unary plus and widening
     268                 :             :    integer conversions.  */
     269                 :             : 
     270                 :             : gfc_expr *
     271                 :      441248 : gfc_discard_nops (gfc_expr *e)
     272                 :             : {
     273                 :      441248 :   gfc_actual_arglist *arglist;
     274                 :             : 
     275                 :      441248 :   if (e == NULL)
     276                 :             :     return NULL;
     277                 :             : 
     278                 :      450607 :   while (true)
     279                 :             :     {
     280                 :      450607 :       if (e->expr_type == EXPR_OP
     281                 :       23767 :           && (e->value.op.op == INTRINSIC_UPLUS
     282                 :       23767 :               || e->value.op.op == INTRINSIC_PARENTHESES))
     283                 :             :         {
     284                 :        1227 :           e = e->value.op.op1;
     285                 :        1227 :           continue;
     286                 :             :         }
     287                 :             : 
     288                 :      449380 :       if (e->expr_type == EXPR_FUNCTION && e->value.function.isym
     289                 :       43354 :           && e->value.function.isym->id == GFC_ISYM_CONVERSION
     290                 :        8921 :           && e->ts.type == BT_INTEGER)
     291                 :             :         {
     292                 :        8842 :           arglist = e->value.function.actual;
     293                 :        8842 :           if (arglist->expr->ts.type == BT_INTEGER
     294                 :        8828 :               && e->ts.kind > arglist->expr->ts.kind)
     295                 :             :             {
     296                 :        8132 :               e = arglist->expr;
     297                 :        8132 :               continue;
     298                 :             :             }
     299                 :             :         }
     300                 :             :       break;
     301                 :             :     }
     302                 :             : 
     303                 :             :   return e;
     304                 :             : }
     305                 :             : 
     306                 :             : 
     307                 :             : /* Compare two expressions.  Return values:
     308                 :             :    * +1 if e1 > e2
     309                 :             :    * 0 if e1 == e2
     310                 :             :    * -1 if e1 < e2
     311                 :             :    * -2 if the relationship could not be determined
     312                 :             :    * -3 if e1 /= e2, but we cannot tell which one is larger.
     313                 :             :    REAL and COMPLEX constants are only compared for equality
     314                 :             :    or inequality; if they are unequal, -2 is returned in all cases.  */
     315                 :             : 
     316                 :             : int
     317                 :      173347 : gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
     318                 :             : {
     319                 :      173347 :   int i;
     320                 :             : 
     321                 :      173347 :   if (e1 == NULL && e2 == NULL)
     322                 :             :     return 0;
     323                 :      173345 :   else if (e1 == NULL || e2 == NULL)
     324                 :             :     return -2;
     325                 :             : 
     326                 :      173344 :   e1 = gfc_discard_nops (e1);
     327                 :      173344 :   e2 = gfc_discard_nops (e2);
     328                 :             : 
     329                 :      173344 :   if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_PLUS)
     330                 :             :     {
     331                 :             :       /* Compare X+C vs. X, for INTEGER only.  */
     332                 :        3989 :       if (e1->value.op.op2->expr_type == EXPR_CONSTANT
     333                 :        1473 :           && e1->value.op.op2->ts.type == BT_INTEGER
     334                 :        5446 :           && gfc_dep_compare_expr (e1->value.op.op1, e2) == 0)
     335                 :         202 :         return mpz_sgn (e1->value.op.op2->value.integer);
     336                 :             : 
     337                 :             :       /* Compare P+Q vs. R+S.  */
     338                 :        3787 :       if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_PLUS)
     339                 :             :         {
     340                 :         845 :           int l, r;
     341                 :             : 
     342                 :         845 :           l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
     343                 :         845 :           r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
     344                 :         845 :           if (l == 0 && r == 0)
     345                 :             :             return 0;
     346                 :         289 :           if (l == 0 && r > -2)
     347                 :             :             return r;
     348                 :         258 :           if (l > -2 && r == 0)
     349                 :             :             return l;
     350                 :         257 :           if (l == 1 && r == 1)
     351                 :             :             return 1;
     352                 :         257 :           if (l == -1 && r == -1)
     353                 :             :             return -1;
     354                 :             : 
     355                 :         257 :           l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op2);
     356                 :         257 :           r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op1);
     357                 :         257 :           if (l == 0 && r == 0)
     358                 :             :             return 0;
     359                 :         253 :           if (l == 0 && r > -2)
     360                 :             :             return r;
     361                 :         253 :           if (l > -2 && r == 0)
     362                 :             :             return l;
     363                 :         253 :           if (l == 1 && r == 1)
     364                 :             :             return 1;
     365                 :         253 :           if (l == -1 && r == -1)
     366                 :             :             return -1;
     367                 :             :         }
     368                 :             :     }
     369                 :             : 
     370                 :             :   /* Compare X vs. X+C, for INTEGER only.  */
     371                 :      172550 :   if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_PLUS)
     372                 :             :     {
     373                 :        3622 :       if (e2->value.op.op2->expr_type == EXPR_CONSTANT
     374                 :        1988 :           && e2->value.op.op2->ts.type == BT_INTEGER
     375                 :        5610 :           && gfc_dep_compare_expr (e1, e2->value.op.op1) == 0)
     376                 :         775 :         return -mpz_sgn (e2->value.op.op2->value.integer);
     377                 :             :     }
     378                 :             : 
     379                 :             :   /* Compare X-C vs. X, for INTEGER only.  */
     380                 :      171775 :   if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_MINUS)
     381                 :             :     {
     382                 :        2136 :       if (e1->value.op.op2->expr_type == EXPR_CONSTANT
     383                 :        1711 :           && e1->value.op.op2->ts.type == BT_INTEGER
     384                 :        3835 :           && gfc_dep_compare_expr (e1->value.op.op1, e2) == 0)
     385                 :          80 :         return -mpz_sgn (e1->value.op.op2->value.integer);
     386                 :             : 
     387                 :             :       /* Compare P-Q vs. R-S.  */
     388                 :        2056 :       if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
     389                 :             :         {
     390                 :         874 :           int l, r;
     391                 :             : 
     392                 :         874 :           l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
     393                 :         874 :           r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
     394                 :         874 :           if (l == 0 && r == 0)
     395                 :             :             return 0;
     396                 :         178 :           if (l > -2 && r == 0)
     397                 :             :             return l;
     398                 :         177 :           if (l == 0 && r > -2)
     399                 :           6 :             return -r;
     400                 :         171 :           if (l == 1 && r == -1)
     401                 :             :             return 1;
     402                 :         171 :           if (l == -1 && r == 1)
     403                 :             :             return -1;
     404                 :             :         }
     405                 :             :     }
     406                 :             : 
     407                 :             :   /* Compare A // B vs. C // D.  */
     408                 :             : 
     409                 :      170992 :   if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_CONCAT
     410                 :         121 :       && e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_CONCAT)
     411                 :             :     {
     412                 :          90 :       int l, r;
     413                 :             : 
     414                 :          90 :       l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
     415                 :          90 :       r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
     416                 :             : 
     417                 :          90 :       if (l != 0)
     418                 :             :         return l;
     419                 :             : 
     420                 :             :       /* Left expressions of // compare equal, but
     421                 :             :          watch out for 'A ' // x vs. 'A' // x.  */
     422                 :          72 :       gfc_expr *e1_left = e1->value.op.op1;
     423                 :          72 :       gfc_expr *e2_left = e2->value.op.op1;
     424                 :             : 
     425                 :          72 :       if (e1_left->expr_type == EXPR_CONSTANT
     426                 :          36 :           && e2_left->expr_type == EXPR_CONSTANT
     427                 :          36 :           && e1_left->value.character.length
     428                 :          36 :           != e2_left->value.character.length)
     429                 :             :         return -2;
     430                 :             :       else
     431                 :             :         return r;
     432                 :             :     }
     433                 :             : 
     434                 :             :   /* Compare X vs. X-C, for INTEGER only.  */
     435                 :      170902 :   if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
     436                 :             :     {
     437                 :        3465 :       if (e2->value.op.op2->expr_type == EXPR_CONSTANT
     438                 :        2631 :           && e2->value.op.op2->ts.type == BT_INTEGER
     439                 :        6070 :           && gfc_dep_compare_expr (e1, e2->value.op.op1) == 0)
     440                 :        1973 :         return mpz_sgn (e2->value.op.op2->value.integer);
     441                 :             :     }
     442                 :             : 
     443                 :      168929 :   if (e1->expr_type != e2->expr_type)
     444                 :             :     return -3;
     445                 :             : 
     446                 :       62370 :   switch (e1->expr_type)
     447                 :             :     {
     448                 :       27664 :     case EXPR_CONSTANT:
     449                 :             :       /* Compare strings for equality.  */
     450                 :       27664 :       if (e1->ts.type == BT_CHARACTER && e2->ts.type == BT_CHARACTER)
     451                 :         122 :         return gfc_compare_string (e1, e2);
     452                 :             : 
     453                 :             :       /* Compare REAL and COMPLEX constants.  Because of the
     454                 :             :          traps and pitfalls associated with comparing
     455                 :             :          a + 1.0 with a + 0.5, check for equality only.  */
     456                 :       27542 :       if (e2->expr_type == EXPR_CONSTANT)
     457                 :             :         {
     458                 :       27542 :           if (e1->ts.type == BT_REAL && e2->ts.type == BT_REAL)
     459                 :             :             {
     460                 :          34 :               if (mpfr_cmp (e1->value.real, e2->value.real) == 0)
     461                 :             :                 return 0;
     462                 :             :               else
     463                 :             :                 return -2;
     464                 :             :             }
     465                 :       27508 :           else if (e1->ts.type == BT_COMPLEX && e2->ts.type == BT_COMPLEX)
     466                 :             :             {
     467                 :           5 :               if (mpc_cmp (e1->value.complex, e2->value.complex) == 0)
     468                 :             :                 return 0;
     469                 :             :               else
     470                 :             :                 return -2;
     471                 :             :             }
     472                 :             :         }
     473                 :             : 
     474                 :       27503 :       if (e1->ts.type != BT_INTEGER || e2->ts.type != BT_INTEGER)
     475                 :             :         return -2;
     476                 :             : 
     477                 :             :       /* For INTEGER, all cases where e2 is not constant should have
     478                 :             :          been filtered out above.  */
     479                 :       27488 :       gcc_assert (e2->expr_type == EXPR_CONSTANT);
     480                 :             : 
     481                 :       27488 :       i = mpz_cmp (e1->value.integer, e2->value.integer);
     482                 :       27488 :       if (i == 0)
     483                 :             :         return 0;
     484                 :       15734 :       else if (i < 0)
     485                 :             :         return -1;
     486                 :             :       return 1;
     487                 :             : 
     488                 :       29672 :     case EXPR_VARIABLE:
     489                 :       29672 :       if (are_identical_variables (e1, e2))
     490                 :             :         return 0;
     491                 :             :       else
     492                 :             :         return -3;
     493                 :             : 
     494                 :        1865 :     case EXPR_OP:
     495                 :             :       /* Intrinsic operators are the same if their operands are the same.  */
     496                 :        1865 :       if (e1->value.op.op != e2->value.op.op)
     497                 :             :         return -2;
     498                 :        1572 :       if (e1->value.op.op2 == 0)
     499                 :             :         {
     500                 :          29 :           i = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
     501                 :          58 :           return i == 0 ? 0 : -2;
     502                 :             :         }
     503                 :        1543 :       if (gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1) == 0
     504                 :        1543 :           && gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2) == 0)
     505                 :             :         return 0;
     506                 :        1235 :       else if (e1->value.op.op == INTRINSIC_TIMES
     507                 :         218 :                && gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op2) == 0
     508                 :        1381 :                && gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op1) == 0)
     509                 :             :         /* Commutativity of multiplication; addition is handled above.  */
     510                 :             :         return 0;
     511                 :             : 
     512                 :             :       return -2;
     513                 :             : 
     514                 :        2921 :     case EXPR_FUNCTION:
     515                 :        2921 :       return gfc_dep_compare_functions (e1, e2, false);
     516                 :             : 
     517                 :             :     default:
     518                 :             :       return -2;
     519                 :             :     }
     520                 :             : }
     521                 :             : 
     522                 :             : 
     523                 :             : /* Return the difference between two expressions.  Integer expressions of
     524                 :             :    the form
     525                 :             : 
     526                 :             :    X + constant, X - constant and constant + X
     527                 :             : 
     528                 :             :    are handled.  Return true on success, false on failure. result is assumed
     529                 :             :    to be uninitialized on entry, and will be initialized on success.
     530                 :             : */
     531                 :             : 
     532                 :             : bool
     533                 :       78426 : gfc_dep_difference (gfc_expr *e1, gfc_expr *e2, mpz_t *result)
     534                 :             : {
     535                 :       78426 :   gfc_expr *e1_op1, *e1_op2, *e2_op1, *e2_op2;
     536                 :             : 
     537                 :       78426 :   if (e1 == NULL || e2 == NULL)
     538                 :             :     return false;
     539                 :             : 
     540                 :       44110 :   if (e1->ts.type != BT_INTEGER || e2->ts.type != BT_INTEGER)
     541                 :             :     return false;
     542                 :             : 
     543                 :       44109 :   e1 = gfc_discard_nops (e1);
     544                 :       44109 :   e2 = gfc_discard_nops (e2);
     545                 :             : 
     546                 :             :   /* Initialize tentatively, clear if we don't return anything.  */
     547                 :       44109 :   mpz_init (*result);
     548                 :             : 
     549                 :             :   /* Case 1: c1 - c2 = c1 - c2, trivially.  */
     550                 :             : 
     551                 :       44109 :   if (e1->expr_type == EXPR_CONSTANT && e2->expr_type == EXPR_CONSTANT)
     552                 :             :     {
     553                 :       35213 :       mpz_sub (*result, e1->value.integer, e2->value.integer);
     554                 :       35213 :       return true;
     555                 :             :     }
     556                 :             : 
     557                 :        8896 :   if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_PLUS)
     558                 :             :     {
     559                 :         831 :       e1_op1 = gfc_discard_nops (e1->value.op.op1);
     560                 :         831 :       e1_op2 = gfc_discard_nops (e1->value.op.op2);
     561                 :             : 
     562                 :             :       /* Case 2: (X + c1) - X = c1.  */
     563                 :         831 :       if (e1_op2->expr_type == EXPR_CONSTANT
     564                 :         831 :           && gfc_dep_compare_expr (e1_op1, e2) == 0)
     565                 :             :         {
     566                 :         237 :           mpz_set (*result, e1_op2->value.integer);
     567                 :         237 :           return true;
     568                 :             :         }
     569                 :             : 
     570                 :             :       /* Case 3: (c1 + X) - X = c1.  */
     571                 :         594 :       if (e1_op1->expr_type == EXPR_CONSTANT
     572                 :         594 :           && gfc_dep_compare_expr (e1_op2, e2) == 0)
     573                 :             :         {
     574                 :           6 :           mpz_set (*result, e1_op1->value.integer);
     575                 :           6 :           return true;
     576                 :             :         }
     577                 :             : 
     578                 :         588 :       if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_PLUS)
     579                 :             :         {
     580                 :         251 :           e2_op1 = gfc_discard_nops (e2->value.op.op1);
     581                 :         251 :           e2_op2 = gfc_discard_nops (e2->value.op.op2);
     582                 :             : 
     583                 :         251 :           if (e1_op2->expr_type == EXPR_CONSTANT)
     584                 :             :             {
     585                 :             :               /* Case 4: X + c1 - (X + c2) = c1 - c2.  */
     586                 :         168 :               if (e2_op2->expr_type == EXPR_CONSTANT
     587                 :         168 :                   && gfc_dep_compare_expr (e1_op1, e2_op1) == 0)
     588                 :             :                 {
     589                 :         128 :                   mpz_sub (*result, e1_op2->value.integer,
     590                 :         128 :                            e2_op2->value.integer);
     591                 :         128 :                   return true;
     592                 :             :                 }
     593                 :             :               /* Case 5: X + c1 - (c2 + X) = c1 - c2.  */
     594                 :          40 :               if (e2_op1->expr_type == EXPR_CONSTANT
     595                 :          40 :                   && gfc_dep_compare_expr (e1_op1, e2_op2) == 0)
     596                 :             :                 {
     597                 :           6 :                   mpz_sub (*result, e1_op2->value.integer,
     598                 :           6 :                            e2_op1->value.integer);
     599                 :           6 :                   return true;
     600                 :             :                 }
     601                 :             :             }
     602                 :          83 :           else if (e1_op1->expr_type == EXPR_CONSTANT)
     603                 :             :             {
     604                 :             :               /* Case 6: c1 + X - (X + c2) = c1 - c2.  */
     605                 :          12 :               if (e2_op2->expr_type == EXPR_CONSTANT
     606                 :          12 :                   && gfc_dep_compare_expr (e1_op2, e2_op1) == 0)
     607                 :             :                 {
     608                 :           6 :                   mpz_sub (*result, e1_op1->value.integer,
     609                 :           6 :                            e2_op2->value.integer);
     610                 :           6 :                   return true;
     611                 :             :                 }
     612                 :             :               /* Case 7: c1 + X - (c2 + X) = c1 - c2.  */
     613                 :           6 :               if (e2_op1->expr_type == EXPR_CONSTANT
     614                 :           6 :                   && gfc_dep_compare_expr (e1_op2, e2_op2) == 0)
     615                 :             :                 {
     616                 :           6 :                   mpz_sub (*result, e1_op1->value.integer,
     617                 :           6 :                            e2_op1->value.integer);
     618                 :           6 :                   return true;
     619                 :             :                 }
     620                 :             :             }
     621                 :             :         }
     622                 :             : 
     623                 :         442 :       if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
     624                 :             :         {
     625                 :          20 :           e2_op1 = gfc_discard_nops (e2->value.op.op1);
     626                 :          20 :           e2_op2 = gfc_discard_nops (e2->value.op.op2);
     627                 :             : 
     628                 :          20 :           if (e1_op2->expr_type == EXPR_CONSTANT)
     629                 :             :             {
     630                 :             :               /* Case 8: X + c1 - (X - c2) = c1 + c2.  */
     631                 :          14 :               if (e2_op2->expr_type == EXPR_CONSTANT
     632                 :          14 :                   && gfc_dep_compare_expr (e1_op1, e2_op1) == 0)
     633                 :             :                 {
     634                 :          12 :                   mpz_add (*result, e1_op2->value.integer,
     635                 :          12 :                            e2_op2->value.integer);
     636                 :          12 :                   return true;
     637                 :             :                 }
     638                 :             :             }
     639                 :           8 :           if (e1_op1->expr_type == EXPR_CONSTANT)
     640                 :             :             {
     641                 :             :               /* Case 9: c1 + X - (X - c2) = c1 + c2.  */
     642                 :           6 :               if (e2_op2->expr_type == EXPR_CONSTANT
     643                 :           6 :                   && gfc_dep_compare_expr (e1_op2, e2_op1) == 0)
     644                 :             :                 {
     645                 :           6 :                   mpz_add (*result, e1_op1->value.integer,
     646                 :           6 :                            e2_op2->value.integer);
     647                 :           6 :                   return true;
     648                 :             :                 }
     649                 :             :             }
     650                 :             :         }
     651                 :             :     }
     652                 :             : 
     653                 :        8489 :   if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_MINUS)
     654                 :             :     {
     655                 :         801 :       e1_op1 = gfc_discard_nops (e1->value.op.op1);
     656                 :         801 :       e1_op2 = gfc_discard_nops (e1->value.op.op2);
     657                 :             : 
     658                 :         801 :       if (e1_op2->expr_type == EXPR_CONSTANT)
     659                 :             :         {
     660                 :             :           /* Case 10: (X - c1) - X = -c1  */
     661                 :             : 
     662                 :         757 :           if (gfc_dep_compare_expr (e1_op1, e2) == 0)
     663                 :             :             {
     664                 :           6 :               mpz_neg (*result, e1_op2->value.integer);
     665                 :           6 :               return true;
     666                 :             :             }
     667                 :             : 
     668                 :         751 :           if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_PLUS)
     669                 :             :             {
     670                 :          33 :               e2_op1 = gfc_discard_nops (e2->value.op.op1);
     671                 :          33 :               e2_op2 = gfc_discard_nops (e2->value.op.op2);
     672                 :             : 
     673                 :             :               /* Case 11: (X - c1) - (X + c2) = -( c1 + c2).  */
     674                 :          33 :               if (e2_op2->expr_type == EXPR_CONSTANT
     675                 :          33 :                   && gfc_dep_compare_expr (e1_op1, e2_op1) == 0)
     676                 :             :                 {
     677                 :          12 :                   mpz_add (*result, e1_op2->value.integer,
     678                 :          12 :                            e2_op2->value.integer);
     679                 :          12 :                   mpz_neg (*result, *result);
     680                 :          12 :                   return true;
     681                 :             :                 }
     682                 :             : 
     683                 :             :               /* Case 12: X - c1 - (c2 + X) = - (c1 + c2).  */
     684                 :          21 :               if (e2_op1->expr_type == EXPR_CONSTANT
     685                 :          21 :                   && gfc_dep_compare_expr (e1_op1, e2_op2) == 0)
     686                 :             :                 {
     687                 :           0 :                   mpz_add (*result, e1_op2->value.integer,
     688                 :           0 :                            e2_op1->value.integer);
     689                 :           0 :                   mpz_neg (*result, *result);
     690                 :           0 :                   return true;
     691                 :             :                 }
     692                 :             :             }
     693                 :             : 
     694                 :         739 :           if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
     695                 :             :             {
     696                 :          22 :               e2_op1 = gfc_discard_nops (e2->value.op.op1);
     697                 :          22 :               e2_op2 = gfc_discard_nops (e2->value.op.op2);
     698                 :             : 
     699                 :             :               /* Case 13: (X - c1) - (X - c2) = c2 - c1.  */
     700                 :          22 :               if (e2_op2->expr_type == EXPR_CONSTANT
     701                 :          22 :                   && gfc_dep_compare_expr (e1_op1, e2_op1) == 0)
     702                 :             :                 {
     703                 :           6 :                   mpz_sub (*result, e2_op2->value.integer,
     704                 :           6 :                            e1_op2->value.integer);
     705                 :           6 :                   return true;
     706                 :             :                 }
     707                 :             :             }
     708                 :             :         }
     709                 :         777 :       if (e1_op1->expr_type == EXPR_CONSTANT)
     710                 :             :         {
     711                 :           8 :           if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
     712                 :             :             {
     713                 :           6 :               e2_op1 = gfc_discard_nops (e2->value.op.op1);
     714                 :           6 :               e2_op2 = gfc_discard_nops (e2->value.op.op2);
     715                 :             : 
     716                 :             :               /* Case 14: (c1 - X) - (c2 - X) == c1 - c2.  */
     717                 :           6 :               if (gfc_dep_compare_expr (e1_op2, e2_op2) == 0)
     718                 :             :                 {
     719                 :           6 :                   mpz_sub (*result, e1_op1->value.integer,
     720                 :           6 :                            e2_op1->value.integer);
     721                 :           6 :                     return true;
     722                 :             :                 }
     723                 :             :             }
     724                 :             : 
     725                 :             :         }
     726                 :             :     }
     727                 :             : 
     728                 :        8459 :   if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_PLUS)
     729                 :             :     {
     730                 :         251 :       e2_op1 = gfc_discard_nops (e2->value.op.op1);
     731                 :         251 :       e2_op2 = gfc_discard_nops (e2->value.op.op2);
     732                 :             : 
     733                 :             :       /* Case 15: X - (X + c2) = -c2.  */
     734                 :         251 :       if (e2_op2->expr_type == EXPR_CONSTANT
     735                 :         251 :           && gfc_dep_compare_expr (e1, e2_op1) == 0)
     736                 :             :         {
     737                 :          12 :           mpz_neg (*result, e2_op2->value.integer);
     738                 :          12 :           return true;
     739                 :             :         }
     740                 :             :       /* Case 16: X - (c2 + X) = -c2.  */
     741                 :         239 :       if (e2_op1->expr_type == EXPR_CONSTANT
     742                 :         239 :           && gfc_dep_compare_expr (e1, e2_op2) == 0)
     743                 :             :         {
     744                 :           6 :           mpz_neg (*result, e2_op1->value.integer);
     745                 :           6 :           return true;
     746                 :             :         }
     747                 :             :     }
     748                 :             : 
     749                 :        8441 :   if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
     750                 :             :     {
     751                 :         118 :       e2_op1 = gfc_discard_nops (e2->value.op.op1);
     752                 :         118 :       e2_op2 = gfc_discard_nops (e2->value.op.op2);
     753                 :             : 
     754                 :             :       /* Case 17: X - (X - c2) = c2.  */
     755                 :         118 :       if (e2_op2->expr_type == EXPR_CONSTANT
     756                 :         118 :           && gfc_dep_compare_expr (e1, e2_op1) == 0)
     757                 :             :         {
     758                 :          55 :           mpz_set (*result, e2_op2->value.integer);
     759                 :          55 :           return true;
     760                 :             :         }
     761                 :             :     }
     762                 :             : 
     763                 :        8386 :   if (gfc_dep_compare_expr (e1, e2) == 0)
     764                 :             :     {
     765                 :             :       /* Case 18: X - X = 0.  */
     766                 :        1560 :       mpz_set_si (*result, 0);
     767                 :        1560 :       return true;
     768                 :             :     }
     769                 :             : 
     770                 :        6826 :   mpz_clear (*result);
     771                 :        6826 :   return false;
     772                 :             : }
     773                 :             : 
     774                 :             : /* Returns 1 if the two ranges are the same and 0 if they are not (or if the
     775                 :             :    results are indeterminate). 'n' is the dimension to compare.  */
     776                 :             : 
     777                 :             : static int
     778                 :        2162 : is_same_range (gfc_array_ref *ar1, gfc_array_ref *ar2, int n)
     779                 :             : {
     780                 :        2162 :   gfc_expr *e1;
     781                 :        2162 :   gfc_expr *e2;
     782                 :        2162 :   int i;
     783                 :             : 
     784                 :             :   /* TODO: More sophisticated range comparison.  */
     785                 :        2162 :   gcc_assert (ar1 && ar2);
     786                 :             : 
     787                 :        2162 :   gcc_assert (ar1->dimen_type[n] == ar2->dimen_type[n]);
     788                 :             : 
     789                 :        2162 :   e1 = ar1->stride[n];
     790                 :        2162 :   e2 = ar2->stride[n];
     791                 :             :   /* Check for mismatching strides.  A NULL stride means a stride of 1.  */
     792                 :        2162 :   if (e1 && !e2)
     793                 :             :     {
     794                 :          63 :       i = gfc_expr_is_one (e1, -1);
     795                 :          63 :       if (i == -1 || i == 0)
     796                 :             :         return 0;
     797                 :             :     }
     798                 :        2099 :   else if (e2 && !e1)
     799                 :             :     {
     800                 :         201 :       i = gfc_expr_is_one (e2, -1);
     801                 :         201 :       if (i == -1 || i == 0)
     802                 :             :         return 0;
     803                 :             :     }
     804                 :        1898 :   else if (e1 && e2)
     805                 :             :     {
     806                 :         238 :       i = gfc_dep_compare_expr (e1, e2);
     807                 :         238 :       if (i != 0)
     808                 :             :         return 0;
     809                 :             :     }
     810                 :             :   /* The strides match.  */
     811                 :             : 
     812                 :             :   /* Check the range start.  */
     813                 :        1793 :   e1 = ar1->start[n];
     814                 :        1793 :   e2 = ar2->start[n];
     815                 :        1793 :   if (e1 || e2)
     816                 :             :     {
     817                 :             :       /* Use the bound of the array if no bound is specified.  */
     818                 :        1005 :       if (ar1->as && !e1)
     819                 :          35 :         e1 = ar1->as->lower[n];
     820                 :             : 
     821                 :        1005 :       if (ar2->as && !e2)
     822                 :          34 :         e2 = ar2->as->lower[n];
     823                 :             : 
     824                 :             :       /* Check we have values for both.  */
     825                 :        1005 :       if (!(e1 && e2))
     826                 :             :         return 0;
     827                 :             : 
     828                 :         969 :       i = gfc_dep_compare_expr (e1, e2);
     829                 :         969 :       if (i != 0)
     830                 :             :         return 0;
     831                 :             :     }
     832                 :             : 
     833                 :             :   /* Check the range end.  */
     834                 :        1188 :   e1 = ar1->end[n];
     835                 :        1188 :   e2 = ar2->end[n];
     836                 :        1188 :   if (e1 || e2)
     837                 :             :     {
     838                 :             :       /* Use the bound of the array if no bound is specified.  */
     839                 :         442 :       if (ar1->as && !e1)
     840                 :          11 :         e1 = ar1->as->upper[n];
     841                 :             : 
     842                 :         442 :       if (ar2->as && !e2)
     843                 :           0 :         e2 = ar2->as->upper[n];
     844                 :             : 
     845                 :             :       /* Check we have values for both.  */
     846                 :         442 :       if (!(e1 && e2))
     847                 :             :         return 0;
     848                 :             : 
     849                 :         442 :       i = gfc_dep_compare_expr (e1, e2);
     850                 :         442 :       if (i != 0)
     851                 :             :         return 0;
     852                 :             :     }
     853                 :             : 
     854                 :             :   return 1;
     855                 :             : }
     856                 :             : 
     857                 :             : 
     858                 :             : /* Some array-returning intrinsics can be implemented by reusing the
     859                 :             :    data from one of the array arguments.  For example, TRANSPOSE does
     860                 :             :    not necessarily need to allocate new data: it can be implemented
     861                 :             :    by copying the original array's descriptor and simply swapping the
     862                 :             :    two dimension specifications.
     863                 :             : 
     864                 :             :    If EXPR is a call to such an intrinsic, return the argument
     865                 :             :    whose data can be reused, otherwise return NULL.  */
     866                 :             : 
     867                 :             : gfc_expr *
     868                 :      223373 : gfc_get_noncopying_intrinsic_argument (gfc_expr *expr)
     869                 :             : {
     870                 :      223373 :   if (expr->expr_type != EXPR_FUNCTION || !expr->value.function.isym)
     871                 :             :     return NULL;
     872                 :             : 
     873                 :       37392 :   switch (expr->value.function.isym->id)
     874                 :             :     {
     875                 :        1729 :     case GFC_ISYM_TRANSPOSE:
     876                 :        1729 :       return expr->value.function.actual->expr;
     877                 :             : 
     878                 :             :     default:
     879                 :             :       return NULL;
     880                 :             :     }
     881                 :             : }
     882                 :             : 
     883                 :             : 
     884                 :             : /* Return true if the result of reference REF can only be constructed
     885                 :             :    using a temporary array.  */
     886                 :             : 
     887                 :             : bool
     888                 :      122938 : gfc_ref_needs_temporary_p (gfc_ref *ref)
     889                 :             : {
     890                 :      122938 :   int n;
     891                 :      122938 :   bool subarray_p;
     892                 :             : 
     893                 :      122938 :   subarray_p = false;
     894                 :      263225 :   for (; ref; ref = ref->next)
     895                 :      140749 :     switch (ref->type)
     896                 :             :       {
     897                 :      123526 :       case REF_ARRAY:
     898                 :             :         /* Vector dimensions are generally not monotonic and must be
     899                 :             :            handled using a temporary.  */
     900                 :      123526 :         if (ref->u.ar.type == AR_SECTION)
     901                 :       50616 :           for (n = 0; n < ref->u.ar.dimen; n++)
     902                 :       30050 :             if (ref->u.ar.dimen_type[n] == DIMEN_VECTOR)
     903                 :             :               return true;
     904                 :             : 
     905                 :             :         subarray_p = true;
     906                 :             :         break;
     907                 :             : 
     908                 :             :       case REF_SUBSTRING:
     909                 :             :         /* Within an array reference, character substrings generally
     910                 :             :            need a temporary.  Character array strides are expressed as
     911                 :             :            multiples of the element size (consistent with other array
     912                 :             :            types), not in characters.  */
     913                 :             :         return subarray_p;
     914                 :             : 
     915                 :             :       case REF_COMPONENT:
     916                 :             :       case REF_INQUIRY:
     917                 :             :         break;
     918                 :             :       }
     919                 :             : 
     920                 :             :   return false;
     921                 :             : }
     922                 :             : 
     923                 :             : 
     924                 :             : static bool
     925                 :          44 : gfc_is_data_pointer (gfc_expr *e)
     926                 :             : {
     927                 :          44 :   gfc_ref *ref;
     928                 :             : 
     929                 :          44 :   if (e->expr_type != EXPR_VARIABLE && e->expr_type != EXPR_FUNCTION)
     930                 :             :     return 0;
     931                 :             : 
     932                 :             :   /* No subreference if it is a function  */
     933                 :          44 :   gcc_assert (e->expr_type == EXPR_VARIABLE || !e->ref);
     934                 :             : 
     935                 :          44 :   if (e->symtree->n.sym->attr.pointer)
     936                 :             :     return 1;
     937                 :             : 
     938                 :          82 :   for (ref = e->ref; ref; ref = ref->next)
     939                 :          42 :     if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer)
     940                 :             :       return 1;
     941                 :             : 
     942                 :             :   return 0;
     943                 :             : }
     944                 :             : 
     945                 :             : 
     946                 :             : /* Return true if array variable VAR could be passed to the same function
     947                 :             :    as argument EXPR without interfering with EXPR.  INTENT is the intent
     948                 :             :    of VAR.
     949                 :             : 
     950                 :             :    This is considerably less conservative than other dependencies
     951                 :             :    because many function arguments will already be copied into a
     952                 :             :    temporary.  */
     953                 :             : 
     954                 :             : static int
     955                 :       10565 : gfc_check_argument_var_dependency (gfc_expr *var, sym_intent intent,
     956                 :             :                                    gfc_expr *expr, gfc_dep_check elemental)
     957                 :             : {
     958                 :       10740 :   gfc_expr *arg;
     959                 :             : 
     960                 :       10740 :   gcc_assert (var->expr_type == EXPR_VARIABLE);
     961                 :       10740 :   gcc_assert (var->rank > 0);
     962                 :             : 
     963                 :       10740 :   switch (expr->expr_type)
     964                 :             :     {
     965                 :        6715 :     case EXPR_VARIABLE:
     966                 :             :       /* In case of elemental subroutines, there is no dependency
     967                 :             :          between two same-range array references.  */
     968                 :        6715 :       if (gfc_ref_needs_temporary_p (expr->ref)
     969                 :        6715 :           || gfc_check_dependency (var, expr, elemental == NOT_ELEMENTAL))
     970                 :             :         {
     971                 :         617 :           if (elemental == ELEM_DONT_CHECK_VARIABLE)
     972                 :             :             {
     973                 :             :               /* Too many false positive with pointers.  */
     974                 :          24 :               if (!gfc_is_data_pointer (var) && !gfc_is_data_pointer (expr))
     975                 :             :                 {
     976                 :             :                   /* Elemental procedures forbid unspecified intents,
     977                 :             :                      and we don't check dependencies for INTENT_IN args.  */
     978                 :          20 :                   gcc_assert (intent == INTENT_OUT || intent == INTENT_INOUT);
     979                 :             : 
     980                 :             :                   /* We are told not to check dependencies.
     981                 :             :                      We do it, however, and issue a warning in case we find one.
     982                 :             :                      If a dependency is found in the case
     983                 :             :                      elemental == ELEM_CHECK_VARIABLE, we will generate
     984                 :             :                      a temporary, so we don't need to bother the user.  */
     985                 :             : 
     986                 :          20 :                   if (var->expr_type == EXPR_VARIABLE
     987                 :          20 :                       && expr->expr_type == EXPR_VARIABLE
     988                 :          20 :                       && strcmp(var->symtree->name, expr->symtree->name) == 0)
     989                 :          18 :                     gfc_warning (0, "INTENT(%s) actual argument at %L might "
     990                 :             :                                  "interfere with actual argument at %L.",
     991                 :             :                                  intent == INTENT_OUT ? "OUT" : "INOUT",
     992                 :             :                                  &var->where, &expr->where);
     993                 :             :                 }
     994                 :          24 :               return 0;
     995                 :             :             }
     996                 :             :           else
     997                 :             :             return 1;
     998                 :             :         }
     999                 :             :       return 0;
    1000                 :             : 
    1001                 :             :     case EXPR_ARRAY:
    1002                 :             :       /* the scalarizer always generates a temporary for array constructors,
    1003                 :             :          so there is no dependency.  */
    1004                 :             :       return 0;
    1005                 :             : 
    1006                 :         807 :     case EXPR_FUNCTION:
    1007                 :         807 :       if (intent != INTENT_IN)
    1008                 :             :         {
    1009                 :         803 :           arg = gfc_get_noncopying_intrinsic_argument (expr);
    1010                 :         803 :           if (arg != NULL)
    1011                 :             :             return gfc_check_argument_var_dependency (var, intent, arg,
    1012                 :             :                                                       NOT_ELEMENTAL);
    1013                 :             :         }
    1014                 :             : 
    1015                 :         632 :       if (elemental != NOT_ELEMENTAL)
    1016                 :             :         {
    1017                 :         128 :           if ((expr->value.function.esym
    1018                 :          82 :                && expr->value.function.esym->attr.elemental)
    1019                 :          58 :               || (expr->value.function.isym
    1020                 :          46 :                   && expr->value.function.isym->elemental))
    1021                 :          76 :             return gfc_check_fncall_dependency (var, intent, NULL,
    1022                 :             :                                                 expr->value.function.actual,
    1023                 :          76 :                                                 ELEM_CHECK_VARIABLE);
    1024                 :             : 
    1025                 :          52 :           if (gfc_inline_intrinsic_function_p (expr))
    1026                 :             :             {
    1027                 :             :               /* The TRANSPOSE case should have been caught in the
    1028                 :             :                  noncopying intrinsic case above.  */
    1029                 :          24 :               gcc_assert (expr->value.function.isym->id != GFC_ISYM_TRANSPOSE);
    1030                 :             : 
    1031                 :          24 :               return gfc_check_fncall_dependency (var, intent, NULL,
    1032                 :             :                                                   expr->value.function.actual,
    1033                 :          24 :                                                   ELEM_CHECK_VARIABLE);
    1034                 :             :             }
    1035                 :             :         }
    1036                 :             :       return 0;
    1037                 :             : 
    1038                 :          96 :     case EXPR_OP:
    1039                 :             :       /* In case of non-elemental procedures, there is no need to catch
    1040                 :             :          dependencies, as we will make a temporary anyway.  */
    1041                 :          96 :       if (elemental)
    1042                 :             :         {
    1043                 :             :           /* If the actual arg EXPR is an expression, we need to catch
    1044                 :             :              a dependency between variables in EXPR and VAR,
    1045                 :             :              an intent((IN)OUT) variable.  */
    1046                 :          42 :           if (expr->value.op.op1
    1047                 :          42 :               && gfc_check_argument_var_dependency (var, intent,
    1048                 :             :                                                     expr->value.op.op1,
    1049                 :             :                                                     ELEM_CHECK_VARIABLE))
    1050                 :             :             return 1;
    1051                 :          24 :           else if (expr->value.op.op2
    1052                 :          24 :                    && gfc_check_argument_var_dependency (var, intent,
    1053                 :             :                                                          expr->value.op.op2,
    1054                 :             :                                                          ELEM_CHECK_VARIABLE))
    1055                 :             :             return 1;
    1056                 :             :         }
    1057                 :             :       return 0;
    1058                 :             : 
    1059                 :             :     default:
    1060                 :             :       return 0;
    1061                 :             :     }
    1062                 :             : }
    1063                 :             : 
    1064                 :             : 
    1065                 :             : /* Like gfc_check_argument_var_dependency, but extended to any
    1066                 :             :    array expression OTHER, not just variables.  */
    1067                 :             : 
    1068                 :             : static int
    1069                 :       10511 : gfc_check_argument_dependency (gfc_expr *other, sym_intent intent,
    1070                 :             :                                gfc_expr *expr, gfc_dep_check elemental)
    1071                 :             : {
    1072                 :       10597 :   switch (other->expr_type)
    1073                 :             :     {
    1074                 :       10511 :     case EXPR_VARIABLE:
    1075                 :       10511 :       return gfc_check_argument_var_dependency (other, intent, expr, elemental);
    1076                 :             : 
    1077                 :          86 :     case EXPR_FUNCTION:
    1078                 :          86 :       other = gfc_get_noncopying_intrinsic_argument (other);
    1079                 :          86 :       if (other != NULL)
    1080                 :             :         return gfc_check_argument_dependency (other, INTENT_IN, expr,
    1081                 :             :                                               NOT_ELEMENTAL);
    1082                 :             : 
    1083                 :             :       return 0;
    1084                 :             : 
    1085                 :             :     default:
    1086                 :             :       return 0;
    1087                 :             :     }
    1088                 :             : }
    1089                 :             : 
    1090                 :             : 
    1091                 :             : /* Like gfc_check_argument_dependency, but check all the arguments in ACTUAL.
    1092                 :             :    FNSYM is the function being called, or NULL if not known.  */
    1093                 :             : 
    1094                 :             : bool
    1095                 :        5764 : gfc_check_fncall_dependency (gfc_expr *other, sym_intent intent,
    1096                 :             :                              gfc_symbol *fnsym, gfc_actual_arglist *actual,
    1097                 :             :                              gfc_dep_check elemental)
    1098                 :             : {
    1099                 :        5764 :   gfc_formal_arglist *formal;
    1100                 :        5764 :   gfc_expr *expr;
    1101                 :             : 
    1102                 :        5764 :   formal = fnsym ? gfc_sym_get_dummy_args (fnsym) : NULL;
    1103                 :       34380 :   for (; actual; actual = actual->next, formal = formal ? formal->next : NULL)
    1104                 :             :     {
    1105                 :       14943 :       expr = actual->expr;
    1106                 :             : 
    1107                 :             :       /* Skip args which are not present.  */
    1108                 :       14943 :       if (!expr)
    1109                 :        2771 :         continue;
    1110                 :             : 
    1111                 :             :       /* Skip other itself.  */
    1112                 :       12172 :       if (expr == other)
    1113                 :        1423 :         continue;
    1114                 :             : 
    1115                 :             :       /* Skip intent(in) arguments if OTHER itself is intent(in).  */
    1116                 :       10749 :       if (formal && intent == INTENT_IN
    1117                 :         270 :           && formal->sym->attr.intent == INTENT_IN)
    1118                 :         238 :         continue;
    1119                 :             : 
    1120                 :       10511 :       if (gfc_check_argument_dependency (other, intent, expr, elemental))
    1121                 :             :         return 1;
    1122                 :             :     }
    1123                 :             : 
    1124                 :             :   return 0;
    1125                 :             : }
    1126                 :             : 
    1127                 :             : 
    1128                 :             : /* Return 1 if e1 and e2 are equivalenced arrays, either
    1129                 :             :    directly or indirectly; i.e., equivalence (a,b) for a and b
    1130                 :             :    or equivalence (a,c),(b,c).  This function uses the equiv_
    1131                 :             :    lists, generated in trans-common(add_equivalences), that are
    1132                 :             :    guaranteed to pick up indirect equivalences.  We explicitly
    1133                 :             :    check for overlap using the offset and length of the equivalence.
    1134                 :             :    This function is symmetric.
    1135                 :             :    TODO: This function only checks whether the full top-level
    1136                 :             :    symbols overlap.  An improved implementation could inspect
    1137                 :             :    e1->ref and e2->ref to determine whether the actually accessed
    1138                 :             :    portions of these variables/arrays potentially overlap.  */
    1139                 :             : 
    1140                 :             : bool
    1141                 :       47007 : gfc_are_equivalenced_arrays (gfc_expr *e1, gfc_expr *e2)
    1142                 :             : {
    1143                 :       47007 :   gfc_equiv_list *l;
    1144                 :       47007 :   gfc_equiv_info *s, *fl1, *fl2;
    1145                 :             : 
    1146                 :       47007 :   gcc_assert (e1->expr_type == EXPR_VARIABLE
    1147                 :             :               && e2->expr_type == EXPR_VARIABLE);
    1148                 :             : 
    1149                 :       47007 :   if (!e1->symtree->n.sym->attr.in_equivalence
    1150                 :         440 :       || !e2->symtree->n.sym->attr.in_equivalence|| !e1->rank || !e2->rank)
    1151                 :             :     return 0;
    1152                 :             : 
    1153                 :         240 :   if (e1->symtree->n.sym->ns
    1154                 :         240 :         && e1->symtree->n.sym->ns != gfc_current_ns)
    1155                 :           6 :     l = e1->symtree->n.sym->ns->equiv_lists;
    1156                 :             :   else
    1157                 :         234 :     l = gfc_current_ns->equiv_lists;
    1158                 :             : 
    1159                 :             :   /* Go through the equiv_lists and return 1 if the variables
    1160                 :             :      e1 and e2 are members of the same group and satisfy the
    1161                 :             :      requirement on their relative offsets.  */
    1162                 :        1788 :   for (; l; l = l->next)
    1163                 :             :     {
    1164                 :        1702 :       fl1 = NULL;
    1165                 :        1702 :       fl2 = NULL;
    1166                 :        3551 :       for (s = l->equiv; s; s = s->next)
    1167                 :             :         {
    1168                 :        2003 :           if (s->sym == e1->symtree->n.sym)
    1169                 :             :             {
    1170                 :         163 :               fl1 = s;
    1171                 :         163 :               if (fl2)
    1172                 :             :                 break;
    1173                 :             :             }
    1174                 :        1979 :           if (s->sym == e2->symtree->n.sym)
    1175                 :             :             {
    1176                 :         163 :               fl2 = s;
    1177                 :         163 :               if (fl1)
    1178                 :             :                 break;
    1179                 :             :             }
    1180                 :             :         }
    1181                 :             : 
    1182                 :        1702 :       if (s)
    1183                 :             :         {
    1184                 :             :           /* Can these lengths be zero?  */
    1185                 :         154 :           if (fl1->length <= 0 || fl2->length <= 0)
    1186                 :             :             return 1;
    1187                 :             :           /* These can't overlap if [f11,fl1+length] is before
    1188                 :             :              [fl2,fl2+length], or [fl2,fl2+length] is before
    1189                 :             :              [fl1,fl1+length], otherwise they do overlap.  */
    1190                 :         154 :           if (fl1->offset + fl1->length > fl2->offset
    1191                 :         154 :               && fl2->offset + fl2->length > fl1->offset)
    1192                 :             :             return 1;
    1193                 :             :         }
    1194                 :             :     }
    1195                 :             :   return 0;
    1196                 :             : }
    1197                 :             : 
    1198                 :             : 
    1199                 :             : /* Return true if there is no possibility of aliasing because of a type
    1200                 :             :    mismatch between all the possible pointer references and the
    1201                 :             :    potential target.  Note that this function is asymmetric in the
    1202                 :             :    arguments and so must be called twice with the arguments exchanged.  */
    1203                 :             : 
    1204                 :             : static bool
    1205                 :         461 : check_data_pointer_types (gfc_expr *expr1, gfc_expr *expr2)
    1206                 :             : {
    1207                 :         461 :   gfc_component *cm1;
    1208                 :         461 :   gfc_symbol *sym1;
    1209                 :         461 :   gfc_symbol *sym2;
    1210                 :         461 :   gfc_ref *ref1;
    1211                 :         461 :   bool seen_component_ref;
    1212                 :             : 
    1213                 :         461 :   if (expr1->expr_type != EXPR_VARIABLE
    1214                 :         461 :         || expr2->expr_type != EXPR_VARIABLE)
    1215                 :             :     return false;
    1216                 :             : 
    1217                 :         461 :   sym1 = expr1->symtree->n.sym;
    1218                 :         461 :   sym2 = expr2->symtree->n.sym;
    1219                 :             : 
    1220                 :             :   /* Keep it simple for now.  */
    1221                 :         461 :   if (sym1->ts.type == BT_DERIVED && sym2->ts.type == BT_DERIVED)
    1222                 :             :     return false;
    1223                 :             : 
    1224                 :         389 :   if (sym1->attr.pointer)
    1225                 :             :     {
    1226                 :         227 :       if (gfc_compare_types (&sym1->ts, &sym2->ts))
    1227                 :             :         return false;
    1228                 :             :     }
    1229                 :             : 
    1230                 :             :   /* This is a conservative check on the components of the derived type
    1231                 :             :      if no component references have been seen.  Since we will not dig
    1232                 :             :      into the components of derived type components, we play it safe by
    1233                 :             :      returning false.  First we check the reference chain and then, if
    1234                 :             :      no component references have been seen, the components.  */
    1235                 :         186 :   seen_component_ref = false;
    1236                 :         186 :   if (sym1->ts.type == BT_DERIVED)
    1237                 :             :     {
    1238                 :          87 :       for (ref1 = expr1->ref; ref1; ref1 = ref1->next)
    1239                 :             :         {
    1240                 :          72 :           if (ref1->type != REF_COMPONENT)
    1241                 :          26 :             continue;
    1242                 :             : 
    1243                 :          46 :           if (ref1->u.c.component->ts.type == BT_DERIVED)
    1244                 :             :             return false;
    1245                 :             : 
    1246                 :          21 :           if ((sym2->attr.pointer || ref1->u.c.component->attr.pointer)
    1247                 :          47 :                 && gfc_compare_types (&ref1->u.c.component->ts, &sym2->ts))
    1248                 :             :             return false;
    1249                 :             : 
    1250                 :             :           seen_component_ref = true;
    1251                 :             :         }
    1252                 :             :     }
    1253                 :             : 
    1254                 :         155 :   if (sym1->ts.type == BT_DERIVED && !seen_component_ref)
    1255                 :             :     {
    1256                 :           0 :       for (cm1 = sym1->ts.u.derived->components; cm1; cm1 = cm1->next)
    1257                 :             :         {
    1258                 :           0 :           if (cm1->ts.type == BT_DERIVED)
    1259                 :             :             return false;
    1260                 :             : 
    1261                 :           0 :           if ((sym2->attr.pointer || cm1->attr.pointer)
    1262                 :           0 :                 && gfc_compare_types (&cm1->ts, &sym2->ts))
    1263                 :             :             return false;
    1264                 :             :         }
    1265                 :             :     }
    1266                 :             : 
    1267                 :             :   return true;
    1268                 :             : }
    1269                 :             : 
    1270                 :             : 
    1271                 :             : /* Return true if the statement body redefines the condition.  Returns
    1272                 :             :    true if expr2 depends on expr1.  expr1 should be a single term
    1273                 :             :    suitable for the lhs of an assignment.  The IDENTICAL flag indicates
    1274                 :             :    whether array references to the same symbol with identical range
    1275                 :             :    references count as a dependency or not.  Used for forall and where
    1276                 :             :    statements.  Also used with functions returning arrays without a
    1277                 :             :    temporary.  */
    1278                 :             : 
    1279                 :             : int
    1280                 :       99920 : gfc_check_dependency (gfc_expr *expr1, gfc_expr *expr2, bool identical)
    1281                 :             : {
    1282                 :       99920 :   gfc_actual_arglist *actual;
    1283                 :       99920 :   gfc_constructor *c;
    1284                 :       99920 :   int n;
    1285                 :             : 
    1286                 :             :   /* -fcoarray=lib can end up here with expr1->expr_type set to EXPR_FUNCTION
    1287                 :             :      and a reference to _F.caf_get, so skip the assert.  */
    1288                 :       99920 :   if (expr1->expr_type == EXPR_FUNCTION
    1289                 :           0 :       && strcmp (expr1->value.function.name, "_F.caf_get") == 0)
    1290                 :             :     return 0;
    1291                 :             : 
    1292                 :       99920 :   if (expr1->expr_type != EXPR_VARIABLE)
    1293                 :           0 :     gfc_internal_error ("gfc_check_dependency: expecting an EXPR_VARIABLE");
    1294                 :             : 
    1295                 :             :   /* Prevent NULL pointer dereference while recursively analyzing invalid
    1296                 :             :      expressions.  */
    1297                 :       99920 :   if (expr2 == NULL)
    1298                 :             :     return 0;
    1299                 :             : 
    1300                 :       99919 :   switch (expr2->expr_type)
    1301                 :             :     {
    1302                 :        8486 :     case EXPR_OP:
    1303                 :        8486 :       n = gfc_check_dependency (expr1, expr2->value.op.op1, identical);
    1304                 :        8486 :       if (n)
    1305                 :             :         return n;
    1306                 :        7321 :       if (expr2->value.op.op2)
    1307                 :        6957 :         return gfc_check_dependency (expr1, expr2->value.op.op2, identical);
    1308                 :             :       return 0;
    1309                 :             : 
    1310                 :       44513 :     case EXPR_VARIABLE:
    1311                 :             :       /* The interesting cases are when the symbols don't match.  */
    1312                 :       44513 :       if (expr1->symtree->n.sym != expr2->symtree->n.sym)
    1313                 :             :         {
    1314                 :       39199 :           symbol_attribute attr1, attr2;
    1315                 :       39199 :           gfc_typespec *ts1 = &expr1->symtree->n.sym->ts;
    1316                 :       39199 :           gfc_typespec *ts2 = &expr2->symtree->n.sym->ts;
    1317                 :             : 
    1318                 :             :           /* Return 1 if expr1 and expr2 are equivalenced arrays.  */
    1319                 :       39199 :           if (gfc_are_equivalenced_arrays (expr1, expr2))
    1320                 :             :             return 1;
    1321                 :             : 
    1322                 :             :           /* Symbols can only alias if they have the same type.  */
    1323                 :       39123 :           if (ts1->type != BT_UNKNOWN && ts2->type != BT_UNKNOWN
    1324                 :       39123 :               && ts1->type != BT_DERIVED && ts2->type != BT_DERIVED)
    1325                 :             :             {
    1326                 :       33136 :               if (ts1->type != ts2->type || ts1->kind != ts2->kind)
    1327                 :             :                 return 0;
    1328                 :             :             }
    1329                 :             : 
    1330                 :             :           /* We have to also include target-target as ptr%comp is not a
    1331                 :             :              pointer but it still alias with "dt%comp" for "ptr => dt".  As
    1332                 :             :              subcomponents and array access to pointers retains the target
    1333                 :             :              attribute, that's sufficient.  */
    1334                 :       32532 :           attr1 = gfc_expr_attr (expr1);
    1335                 :       32532 :           attr2 = gfc_expr_attr (expr2);
    1336                 :       32532 :           if ((attr1.pointer || attr1.target) && (attr2.pointer || attr2.target))
    1337                 :             :             {
    1338                 :         362 :               if (check_data_pointer_types (expr1, expr2)
    1339                 :         362 :                     && check_data_pointer_types (expr2, expr1))
    1340                 :             :                 return 0;
    1341                 :             : 
    1342                 :         306 :               return 1;
    1343                 :             :             }
    1344                 :             :           else
    1345                 :             :             {
    1346                 :       32170 :               gfc_symbol *sym1 = expr1->symtree->n.sym;
    1347                 :       32170 :               gfc_symbol *sym2 = expr2->symtree->n.sym;
    1348                 :       32170 :               if (sym1->attr.target && sym2->attr.target
    1349                 :           0 :                   && ((sym1->attr.dummy && !sym1->attr.contiguous
    1350                 :           0 :                        && (!sym1->attr.dimension
    1351                 :           0 :                            || sym2->as->type == AS_ASSUMED_SHAPE))
    1352                 :           0 :                       || (sym2->attr.dummy && !sym2->attr.contiguous
    1353                 :           0 :                           && (!sym2->attr.dimension
    1354                 :           0 :                               || sym2->as->type == AS_ASSUMED_SHAPE))))
    1355                 :             :                 return 1;
    1356                 :             :             }
    1357                 :             : 
    1358                 :             :           /* Otherwise distinct symbols have no dependencies.  */
    1359                 :             :           return 0;
    1360                 :             :         }
    1361                 :             : 
    1362                 :             :       /* Identical and disjoint ranges return 0,
    1363                 :             :          overlapping ranges return 1.  */
    1364                 :        5314 :       if (expr1->ref && expr2->ref)
    1365                 :        5242 :         return gfc_dep_resolver (expr1->ref, expr2->ref, NULL, identical);
    1366                 :             : 
    1367                 :             :       return 1;
    1368                 :             : 
    1369                 :       13401 :     case EXPR_FUNCTION:
    1370                 :       13401 :       if (gfc_get_noncopying_intrinsic_argument (expr2) != NULL)
    1371                 :         404 :         identical = 1;
    1372                 :             : 
    1373                 :             :       /* Remember possible differences between elemental and
    1374                 :             :          transformational functions.  All functions inside a FORALL
    1375                 :             :          will be pure.  */
    1376                 :       13401 :       for (actual = expr2->value.function.actual;
    1377                 :       44104 :            actual; actual = actual->next)
    1378                 :             :         {
    1379                 :       32081 :           if (!actual->expr)
    1380                 :        6496 :             continue;
    1381                 :       25585 :           n = gfc_check_dependency (expr1, actual->expr, identical);
    1382                 :       25585 :           if (n)
    1383                 :        1378 :             return n;
    1384                 :             :         }
    1385                 :             :       return 0;
    1386                 :             : 
    1387                 :             :     case EXPR_CONSTANT:
    1388                 :             :     case EXPR_NULL:
    1389                 :             :       return 0;
    1390                 :             : 
    1391                 :       10454 :     case EXPR_ARRAY:
    1392                 :             :       /* Loop through the array constructor's elements.  */
    1393                 :       10454 :       for (c = gfc_constructor_first (expr2->value.constructor);
    1394                 :       79718 :            c; c = gfc_constructor_next (c))
    1395                 :             :         {
    1396                 :             :           /* If this is an iterator, assume the worst.  */
    1397                 :       70224 :           if (c->iterator)
    1398                 :             :             return 1;
    1399                 :             :           /* Avoid recursion in the common case.  */
    1400                 :       69674 :           if (c->expr->expr_type == EXPR_CONSTANT)
    1401                 :       67795 :             continue;
    1402                 :        1879 :           if (gfc_check_dependency (expr1, c->expr, 1))
    1403                 :             :             return 1;
    1404                 :             :         }
    1405                 :             :       return 0;
    1406                 :             : 
    1407                 :             :     default:
    1408                 :             :       return 1;
    1409                 :             :     }
    1410                 :             : }
    1411                 :             : 
    1412                 :             : 
    1413                 :             : /* Determines overlapping for two array sections.  */
    1414                 :             : 
    1415                 :             : static gfc_dependency
    1416                 :        2162 : check_section_vs_section (gfc_array_ref *l_ar, gfc_array_ref *r_ar, int n)
    1417                 :             : {
    1418                 :        2162 :   gfc_expr *l_start;
    1419                 :        2162 :   gfc_expr *l_end;
    1420                 :        2162 :   gfc_expr *l_stride;
    1421                 :        2162 :   gfc_expr *l_lower;
    1422                 :        2162 :   gfc_expr *l_upper;
    1423                 :        2162 :   int l_dir;
    1424                 :             : 
    1425                 :        2162 :   gfc_expr *r_start;
    1426                 :        2162 :   gfc_expr *r_end;
    1427                 :        2162 :   gfc_expr *r_stride;
    1428                 :        2162 :   gfc_expr *r_lower;
    1429                 :        2162 :   gfc_expr *r_upper;
    1430                 :        2162 :   gfc_expr *one_expr;
    1431                 :        2162 :   int r_dir;
    1432                 :        2162 :   int stride_comparison;
    1433                 :        2162 :   int start_comparison;
    1434                 :        2162 :   mpz_t tmp;
    1435                 :             : 
    1436                 :             :   /* If they are the same range, return without more ado.  */
    1437                 :        2162 :   if (is_same_range (l_ar, r_ar, n))
    1438                 :             :     return GFC_DEP_EQUAL;
    1439                 :             : 
    1440                 :        1007 :   l_start = l_ar->start[n];
    1441                 :        1007 :   l_end = l_ar->end[n];
    1442                 :        1007 :   l_stride = l_ar->stride[n];
    1443                 :             : 
    1444                 :        1007 :   r_start = r_ar->start[n];
    1445                 :        1007 :   r_end = r_ar->end[n];
    1446                 :        1007 :   r_stride = r_ar->stride[n];
    1447                 :             : 
    1448                 :             :   /* If l_start is NULL take it from array specifier.  */
    1449                 :        1007 :   if (l_start == NULL && IS_ARRAY_EXPLICIT (l_ar->as))
    1450                 :         122 :     l_start = l_ar->as->lower[n];
    1451                 :             :   /* If l_end is NULL take it from array specifier.  */
    1452                 :        1007 :   if (l_end == NULL && IS_ARRAY_EXPLICIT (l_ar->as))
    1453                 :         135 :     l_end = l_ar->as->upper[n];
    1454                 :             : 
    1455                 :             :   /* If r_start is NULL take it from array specifier.  */
    1456                 :        1007 :   if (r_start == NULL && IS_ARRAY_EXPLICIT (r_ar->as))
    1457                 :          40 :     r_start = r_ar->as->lower[n];
    1458                 :             :   /* If r_end is NULL take it from array specifier.  */
    1459                 :        1007 :   if (r_end == NULL && IS_ARRAY_EXPLICIT (r_ar->as))
    1460                 :          28 :     r_end = r_ar->as->upper[n];
    1461                 :             : 
    1462                 :             :   /* Determine whether the l_stride is positive or negative.  */
    1463                 :        1007 :   if (!l_stride)
    1464                 :             :     l_dir = 1;
    1465                 :         295 :   else if (l_stride->expr_type == EXPR_CONSTANT
    1466                 :         214 :            && l_stride->ts.type == BT_INTEGER)
    1467                 :         214 :     l_dir = mpz_sgn (l_stride->value.integer);
    1468                 :          81 :   else if (l_start && l_end)
    1469                 :          81 :     l_dir = gfc_dep_compare_expr (l_end, l_start);
    1470                 :             :   else
    1471                 :             :     l_dir = -2;
    1472                 :             : 
    1473                 :             :   /* Determine whether the r_stride is positive or negative.  */
    1474                 :        1007 :   if (!r_stride)
    1475                 :             :     r_dir = 1;
    1476                 :         433 :   else if (r_stride->expr_type == EXPR_CONSTANT
    1477                 :         391 :            && r_stride->ts.type == BT_INTEGER)
    1478                 :         391 :     r_dir = mpz_sgn (r_stride->value.integer);
    1479                 :          42 :   else if (r_start && r_end)
    1480                 :          42 :     r_dir = gfc_dep_compare_expr (r_end, r_start);
    1481                 :             :   else
    1482                 :             :     r_dir = -2;
    1483                 :             : 
    1484                 :             :   /* The strides should never be zero.  */
    1485                 :        1007 :   if (l_dir == 0 || r_dir == 0)
    1486                 :             :     return GFC_DEP_OVERLAP;
    1487                 :             : 
    1488                 :             :   /* Determine the relationship between the strides.  Set stride_comparison to
    1489                 :             :      -2 if the dependency cannot be determined
    1490                 :             :      -1 if l_stride < r_stride
    1491                 :             :       0 if l_stride == r_stride
    1492                 :             :       1 if l_stride > r_stride
    1493                 :             :      as determined by gfc_dep_compare_expr.  */
    1494                 :             : 
    1495                 :        1007 :   one_expr = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1);
    1496                 :             : 
    1497                 :        2293 :   stride_comparison = gfc_dep_compare_expr (l_stride ? l_stride : one_expr,
    1498                 :             :                                             r_stride ? r_stride : one_expr);
    1499                 :             : 
    1500                 :        1007 :   if (l_start && r_start)
    1501                 :         898 :     start_comparison = gfc_dep_compare_expr (l_start, r_start);
    1502                 :             :   else
    1503                 :             :     start_comparison = -2;
    1504                 :             : 
    1505                 :        1007 :   gfc_free_expr (one_expr);
    1506                 :             : 
    1507                 :             :   /* Determine LHS upper and lower bounds.  */
    1508                 :        1007 :   if (l_dir == 1)
    1509                 :             :     {
    1510                 :             :       l_lower = l_start;
    1511                 :             :       l_upper = l_end;
    1512                 :             :     }
    1513                 :         181 :   else if (l_dir == -1)
    1514                 :             :     {
    1515                 :             :       l_lower = l_end;
    1516                 :             :       l_upper = l_start;
    1517                 :             :     }
    1518                 :             :   else
    1519                 :             :     {
    1520                 :          37 :       l_lower = NULL;
    1521                 :          37 :       l_upper = NULL;
    1522                 :             :     }
    1523                 :             : 
    1524                 :             :   /* Determine RHS upper and lower bounds.  */
    1525                 :        1007 :   if (r_dir == 1)
    1526                 :             :     {
    1527                 :             :       r_lower = r_start;
    1528                 :             :       r_upper = r_end;
    1529                 :             :     }
    1530                 :         305 :   else if (r_dir == -1)
    1531                 :             :     {
    1532                 :             :       r_lower = r_end;
    1533                 :             :       r_upper = r_start;
    1534                 :             :     }
    1535                 :             :   else
    1536                 :             :     {
    1537                 :          20 :       r_lower = NULL;
    1538                 :          20 :       r_upper = NULL;
    1539                 :             :     }
    1540                 :             : 
    1541                 :             :   /* Check whether the ranges are disjoint.  */
    1542                 :        1007 :   if (l_upper && r_lower && gfc_dep_compare_expr (l_upper, r_lower) == -1)
    1543                 :             :     return GFC_DEP_NODEP;
    1544                 :         994 :   if (r_upper && l_lower && gfc_dep_compare_expr (r_upper, l_lower) == -1)
    1545                 :             :     return GFC_DEP_NODEP;
    1546                 :             : 
    1547                 :             :   /* Handle cases like x:y:1 vs. x:z:-1 as GFC_DEP_EQUAL.  */
    1548                 :         910 :   if (l_start && r_start && gfc_dep_compare_expr (l_start, r_start) == 0)
    1549                 :             :     {
    1550                 :          34 :       if (l_dir == 1 && r_dir == -1)
    1551                 :             :         return GFC_DEP_EQUAL;
    1552                 :          21 :       if (l_dir == -1 && r_dir == 1)
    1553                 :             :         return GFC_DEP_EQUAL;
    1554                 :             :     }
    1555                 :             : 
    1556                 :             :   /* Handle cases like x:y:1 vs. z:y:-1 as GFC_DEP_EQUAL.  */
    1557                 :         895 :   if (l_end && r_end && gfc_dep_compare_expr (l_end, r_end) == 0)
    1558                 :             :     {
    1559                 :          39 :       if (l_dir == 1 && r_dir == -1)
    1560                 :             :         return GFC_DEP_EQUAL;
    1561                 :          39 :       if (l_dir == -1 && r_dir == 1)
    1562                 :             :         return GFC_DEP_EQUAL;
    1563                 :             :     }
    1564                 :             : 
    1565                 :             :   /* Handle cases like x:y:2 vs. x+1:z:4 as GFC_DEP_NODEP.
    1566                 :             :      There is no dependency if the remainder of
    1567                 :             :      (l_start - r_start) / gcd(l_stride, r_stride) is
    1568                 :             :      nonzero.
    1569                 :             :      TODO:
    1570                 :             :        - Cases like a(1:4:2) = a(2:3) are still not handled.
    1571                 :             :   */
    1572                 :             : 
    1573                 :             : #define IS_CONSTANT_INTEGER(a) ((a) && ((a)->expr_type == EXPR_CONSTANT) \
    1574                 :             :                               && (a)->ts.type == BT_INTEGER)
    1575                 :             : 
    1576                 :         252 :   if (IS_CONSTANT_INTEGER (l_stride) && IS_CONSTANT_INTEGER (r_stride)
    1577                 :        1022 :       && gfc_dep_difference (l_start, r_start, &tmp))
    1578                 :             :     {
    1579                 :         153 :       mpz_t gcd;
    1580                 :         153 :       int result;
    1581                 :             : 
    1582                 :         153 :       mpz_init (gcd);
    1583                 :         153 :       mpz_gcd (gcd, l_stride->value.integer, r_stride->value.integer);
    1584                 :             : 
    1585                 :         153 :       mpz_fdiv_r (tmp, tmp, gcd);
    1586                 :         153 :       result = mpz_cmp_si (tmp, 0L);
    1587                 :             : 
    1588                 :         153 :       mpz_clear (gcd);
    1589                 :         153 :       mpz_clear (tmp);
    1590                 :             : 
    1591                 :         153 :       if (result != 0)
    1592                 :          29 :         return GFC_DEP_NODEP;
    1593                 :             :     }
    1594                 :             : 
    1595                 :             : #undef IS_CONSTANT_INTEGER
    1596                 :             : 
    1597                 :             :   /* Check for forward dependencies x:y vs. x+1:z and x:y:z vs. x:y:z+1.  */
    1598                 :             : 
    1599                 :         838 :   if (l_dir == 1 && r_dir == 1 &&
    1600                 :         506 :       (start_comparison == 0 || start_comparison == -1)
    1601                 :         183 :       && (stride_comparison == 0 || stride_comparison == -1))
    1602                 :             :           return GFC_DEP_FORWARD;
    1603                 :             : 
    1604                 :             :   /* Check for forward dependencies x:y:-1 vs. x-1:z:-1 and
    1605                 :             :      x:y:-1 vs. x:y:-2.  */
    1606                 :         657 :   if (l_dir == -1 && r_dir == -1 &&
    1607                 :          87 :       (start_comparison == 0 || start_comparison == 1)
    1608                 :          87 :       && (stride_comparison == 0 || stride_comparison == 1))
    1609                 :             :     return GFC_DEP_FORWARD;
    1610                 :             : 
    1611                 :         611 :   if (stride_comparison == 0 || stride_comparison == -1)
    1612                 :             :     {
    1613                 :         329 :       if (l_start && IS_ARRAY_EXPLICIT (l_ar->as))
    1614                 :             :         {
    1615                 :             : 
    1616                 :             :           /* Check for a(low:y:s) vs. a(z:x:s) or
    1617                 :             :              a(low:y:s) vs. a(z:x:s+1) where a has a lower bound
    1618                 :             :              of low, which is always at least a forward dependence.  */
    1619                 :             : 
    1620                 :         262 :           if (r_dir == 1
    1621                 :         262 :               && gfc_dep_compare_expr (l_start, l_ar->as->lower[n]) == 0)
    1622                 :             :             return GFC_DEP_FORWARD;
    1623                 :             :         }
    1624                 :             :     }
    1625                 :             : 
    1626                 :         609 :   if (stride_comparison == 0 || stride_comparison == 1)
    1627                 :             :     {
    1628                 :         517 :       if (l_start && IS_ARRAY_EXPLICIT (l_ar->as))
    1629                 :             :         {
    1630                 :             : 
    1631                 :             :           /* Check for a(high:y:-s) vs. a(z:x:-s) or
    1632                 :             :              a(high:y:-s vs. a(z:x:-s-1) where a has a higher bound
    1633                 :             :              of high, which is always at least a forward dependence.  */
    1634                 :             : 
    1635                 :         375 :           if (r_dir == -1
    1636                 :         375 :               && gfc_dep_compare_expr (l_start, l_ar->as->upper[n]) == 0)
    1637                 :             :             return GFC_DEP_FORWARD;
    1638                 :             :         }
    1639                 :             :     }
    1640                 :             : 
    1641                 :             : 
    1642                 :         515 :   if (stride_comparison == 0)
    1643                 :             :     {
    1644                 :             :       /* From here, check for backwards dependencies.  */
    1645                 :             :       /* x+1:y vs. x:z.  */
    1646                 :         314 :       if (l_dir == 1 && r_dir == 1  && start_comparison == 1)
    1647                 :             :         return GFC_DEP_BACKWARD;
    1648                 :             : 
    1649                 :             :       /* x-1:y:-1 vs. x:z:-1.  */
    1650                 :          83 :       if (l_dir == -1 && r_dir == -1 && start_comparison == -1)
    1651                 :             :         return GFC_DEP_BACKWARD;
    1652                 :             :     }
    1653                 :             : 
    1654                 :             :   return GFC_DEP_OVERLAP;
    1655                 :             : }
    1656                 :             : 
    1657                 :             : 
    1658                 :             : /* Determines overlapping for a single element and a section.  */
    1659                 :             : 
    1660                 :             : static gfc_dependency
    1661                 :         230 : gfc_check_element_vs_section( gfc_ref *lref, gfc_ref *rref, int n)
    1662                 :             : {
    1663                 :         230 :   gfc_array_ref *ref;
    1664                 :         230 :   gfc_expr *elem;
    1665                 :         230 :   gfc_expr *start;
    1666                 :         230 :   gfc_expr *end;
    1667                 :         230 :   gfc_expr *stride;
    1668                 :         230 :   int s;
    1669                 :             : 
    1670                 :         230 :   elem = lref->u.ar.start[n];
    1671                 :         230 :   if (!elem)
    1672                 :             :     return GFC_DEP_OVERLAP;
    1673                 :             : 
    1674                 :         230 :   ref = &rref->u.ar;
    1675                 :         230 :   start = ref->start[n] ;
    1676                 :         230 :   end = ref->end[n] ;
    1677                 :         230 :   stride = ref->stride[n];
    1678                 :             : 
    1679                 :         230 :   if (!start && IS_ARRAY_EXPLICIT (ref->as))
    1680                 :         105 :     start = ref->as->lower[n];
    1681                 :         230 :   if (!end && IS_ARRAY_EXPLICIT (ref->as))
    1682                 :         105 :     end = ref->as->upper[n];
    1683                 :             : 
    1684                 :             :   /* Determine whether the stride is positive or negative.  */
    1685                 :         230 :   if (!stride)
    1686                 :             :     s = 1;
    1687                 :           0 :   else if (stride->expr_type == EXPR_CONSTANT
    1688                 :           0 :            && stride->ts.type == BT_INTEGER)
    1689                 :           0 :     s = mpz_sgn (stride->value.integer);
    1690                 :             :   else
    1691                 :             :     s = -2;
    1692                 :             : 
    1693                 :             :   /* Stride should never be zero.  */
    1694                 :           0 :   if (s == 0)
    1695                 :             :     return GFC_DEP_OVERLAP;
    1696                 :             : 
    1697                 :             :   /* Positive strides.  */
    1698                 :         230 :   if (s == 1)
    1699                 :             :     {
    1700                 :             :       /* Check for elem < lower.  */
    1701                 :         230 :       if (start && gfc_dep_compare_expr (elem, start) == -1)
    1702                 :             :         return GFC_DEP_NODEP;
    1703                 :             :       /* Check for elem > upper.  */
    1704                 :         229 :       if (end && gfc_dep_compare_expr (elem, end) == 1)
    1705                 :             :         return GFC_DEP_NODEP;
    1706                 :             : 
    1707                 :         229 :       if (start && end)
    1708                 :             :         {
    1709                 :         155 :           s = gfc_dep_compare_expr (start, end);
    1710                 :             :           /* Check for an empty range.  */
    1711                 :         155 :           if (s == 1)
    1712                 :             :             return GFC_DEP_NODEP;
    1713                 :         155 :           if (s == 0 && gfc_dep_compare_expr (elem, start) == 0)
    1714                 :             :             return GFC_DEP_EQUAL;
    1715                 :             :         }
    1716                 :             :     }
    1717                 :             :   /* Negative strides.  */
    1718                 :           0 :   else if (s == -1)
    1719                 :             :     {
    1720                 :             :       /* Check for elem > upper.  */
    1721                 :           0 :       if (end && gfc_dep_compare_expr (elem, start) == 1)
    1722                 :             :         return GFC_DEP_NODEP;
    1723                 :             :       /* Check for elem < lower.  */
    1724                 :           0 :       if (start && gfc_dep_compare_expr (elem, end) == -1)
    1725                 :             :         return GFC_DEP_NODEP;
    1726                 :             : 
    1727                 :           0 :       if (start && end)
    1728                 :             :         {
    1729                 :           0 :           s = gfc_dep_compare_expr (start, end);
    1730                 :             :           /* Check for an empty range.  */
    1731                 :           0 :           if (s == -1)
    1732                 :             :             return GFC_DEP_NODEP;
    1733                 :           0 :           if (s == 0 && gfc_dep_compare_expr (elem, start) == 0)
    1734                 :             :             return GFC_DEP_EQUAL;
    1735                 :             :         }
    1736                 :             :     }
    1737                 :             :   /* Unknown strides.  */
    1738                 :             :   else
    1739                 :             :     {
    1740                 :           0 :       if (!start || !end)
    1741                 :             :         return GFC_DEP_OVERLAP;
    1742                 :           0 :       s = gfc_dep_compare_expr (start, end);
    1743                 :           0 :       if (s <= -2)
    1744                 :             :         return GFC_DEP_OVERLAP;
    1745                 :             :       /* Assume positive stride.  */
    1746                 :           0 :       if (s == -1)
    1747                 :             :         {
    1748                 :             :           /* Check for elem < lower.  */
    1749                 :           0 :           if (gfc_dep_compare_expr (elem, start) == -1)
    1750                 :             :             return GFC_DEP_NODEP;
    1751                 :             :           /* Check for elem > upper.  */
    1752                 :           0 :           if (gfc_dep_compare_expr (elem, end) == 1)
    1753                 :             :             return GFC_DEP_NODEP;
    1754                 :             :         }
    1755                 :             :       /* Assume negative stride.  */
    1756                 :           0 :       else if (s == 1)
    1757                 :             :         {
    1758                 :             :           /* Check for elem > upper.  */
    1759                 :           0 :           if (gfc_dep_compare_expr (elem, start) == 1)
    1760                 :             :             return GFC_DEP_NODEP;
    1761                 :             :           /* Check for elem < lower.  */
    1762                 :           0 :           if (gfc_dep_compare_expr (elem, end) == -1)
    1763                 :             :             return GFC_DEP_NODEP;
    1764                 :             :         }
    1765                 :             :       /* Equal bounds.  */
    1766                 :           0 :       else if (s == 0)
    1767                 :             :         {
    1768                 :           0 :           s = gfc_dep_compare_expr (elem, start);
    1769                 :           0 :           if (s == 0)
    1770                 :             :             return GFC_DEP_EQUAL;
    1771                 :           0 :           if (s == 1 || s == -1)
    1772                 :             :             return GFC_DEP_NODEP;
    1773                 :             :         }
    1774                 :             :     }
    1775                 :             : 
    1776                 :             :   return GFC_DEP_OVERLAP;
    1777                 :             : }
    1778                 :             : 
    1779                 :             : 
    1780                 :             : /* Traverse expr, checking all EXPR_VARIABLE symbols for their
    1781                 :             :    forall_index attribute.  Return true if any variable may be
    1782                 :             :    being used as a FORALL index.  Its safe to pessimistically
    1783                 :             :    return true, and assume a dependency.  */
    1784                 :             : 
    1785                 :             : static bool
    1786                 :        6233 : contains_forall_index_p (gfc_expr *expr)
    1787                 :             : {
    1788                 :        6233 :   gfc_actual_arglist *arg;
    1789                 :        6233 :   gfc_constructor *c;
    1790                 :        6233 :   gfc_ref *ref;
    1791                 :        6233 :   int i;
    1792                 :             : 
    1793                 :        6233 :   if (!expr)
    1794                 :             :     return false;
    1795                 :             : 
    1796                 :        6233 :   switch (expr->expr_type)
    1797                 :             :     {
    1798                 :        3128 :     case EXPR_VARIABLE:
    1799                 :        3128 :       if (expr->symtree->n.sym->forall_index)
    1800                 :             :         return true;
    1801                 :             :       break;
    1802                 :             : 
    1803                 :        1424 :     case EXPR_OP:
    1804                 :        1424 :       if (contains_forall_index_p (expr->value.op.op1)
    1805                 :        1424 :           || contains_forall_index_p (expr->value.op.op2))
    1806                 :           7 :         return true;
    1807                 :             :       break;
    1808                 :             : 
    1809                 :           0 :     case EXPR_FUNCTION:
    1810                 :           0 :       for (arg = expr->value.function.actual; arg; arg = arg->next)
    1811                 :           0 :         if (contains_forall_index_p (arg->expr))
    1812                 :             :           return true;
    1813                 :             :       break;
    1814                 :             : 
    1815                 :             :     case EXPR_CONSTANT:
    1816                 :             :     case EXPR_NULL:
    1817                 :             :     case EXPR_SUBSTRING:
    1818                 :             :       break;
    1819                 :             : 
    1820                 :           0 :     case EXPR_STRUCTURE:
    1821                 :           0 :     case EXPR_ARRAY:
    1822                 :           0 :       for (c = gfc_constructor_first (expr->value.constructor);
    1823                 :           0 :            c; gfc_constructor_next (c))
    1824                 :           0 :         if (contains_forall_index_p (c->expr))
    1825                 :             :           return true;
    1826                 :             :       break;
    1827                 :             : 
    1828                 :           0 :     default:
    1829                 :           0 :       gcc_unreachable ();
    1830                 :             :     }
    1831                 :             : 
    1832                 :        5993 :   for (ref = expr->ref; ref; ref = ref->next)
    1833                 :           6 :     switch (ref->type)
    1834                 :             :       {
    1835                 :             :       case REF_ARRAY:
    1836                 :           6 :         for (i = 0; i < ref->u.ar.dimen; i++)
    1837                 :           6 :           if (contains_forall_index_p (ref->u.ar.start[i])
    1838                 :           0 :               || contains_forall_index_p (ref->u.ar.end[i])
    1839                 :           6 :               || contains_forall_index_p (ref->u.ar.stride[i]))
    1840                 :           6 :             return true;
    1841                 :             :         break;
    1842                 :             : 
    1843                 :             :       case REF_COMPONENT:
    1844                 :             :         break;
    1845                 :             : 
    1846                 :           0 :       case REF_SUBSTRING:
    1847                 :           0 :         if (contains_forall_index_p (ref->u.ss.start)
    1848                 :           0 :             || contains_forall_index_p (ref->u.ss.end))
    1849                 :           0 :           return true;
    1850                 :             :         break;
    1851                 :             : 
    1852                 :           0 :       default:
    1853                 :           0 :         gcc_unreachable ();
    1854                 :             :       }
    1855                 :             : 
    1856                 :             :   return false;
    1857                 :             : }
    1858                 :             : 
    1859                 :             : /* Determines overlapping for two single element array references.  */
    1860                 :             : 
    1861                 :             : static gfc_dependency
    1862                 :        2203 : gfc_check_element_vs_element (gfc_ref *lref, gfc_ref *rref, int n)
    1863                 :             : {
    1864                 :        2203 :   gfc_array_ref l_ar;
    1865                 :        2203 :   gfc_array_ref r_ar;
    1866                 :        2203 :   gfc_expr *l_start;
    1867                 :        2203 :   gfc_expr *r_start;
    1868                 :        2203 :   int i;
    1869                 :             : 
    1870                 :        2203 :   l_ar = lref->u.ar;
    1871                 :        2203 :   r_ar = rref->u.ar;
    1872                 :        2203 :   l_start = l_ar.start[n] ;
    1873                 :        2203 :   r_start = r_ar.start[n] ;
    1874                 :        2203 :   i = gfc_dep_compare_expr (r_start, l_start);
    1875                 :        2203 :   if (i == 0)
    1876                 :             :     return GFC_DEP_EQUAL;
    1877                 :             : 
    1878                 :             :   /* Treat two scalar variables as potentially equal.  This allows
    1879                 :             :      us to prove that a(i,:) and a(j,:) have no dependency.  See
    1880                 :             :      Gerald Roth, "Evaluation of Array Syntax Dependence Analysis",
    1881                 :             :      Proceedings of the International Conference on Parallel and
    1882                 :             :      Distributed Processing Techniques and Applications (PDPTA2001),
    1883                 :             :      Las Vegas, Nevada, June 2001.  */
    1884                 :             :   /* However, we need to be careful when either scalar expression
    1885                 :             :      contains a FORALL index, as these can potentially change value
    1886                 :             :      during the scalarization/traversal of this array reference.  */
    1887                 :        1806 :   if (contains_forall_index_p (r_start) || contains_forall_index_p (l_start))
    1888                 :         233 :     return GFC_DEP_OVERLAP;
    1889                 :             : 
    1890                 :        1573 :   if (i > -2)
    1891                 :             :     return GFC_DEP_NODEP;
    1892                 :             : 
    1893                 :             :   return GFC_DEP_EQUAL;
    1894                 :             : }
    1895                 :             : 
    1896                 :             : /* Callback function for checking if an expression depends on a
    1897                 :             :    dummy variable which is any other than INTENT(IN).  */
    1898                 :             : 
    1899                 :             : static int
    1900                 :        4806 : callback_dummy_intent_not_in (gfc_expr **ep,
    1901                 :             :                               int *walk_subtrees ATTRIBUTE_UNUSED,
    1902                 :             :                               void *data ATTRIBUTE_UNUSED)
    1903                 :             : {
    1904                 :        4806 :   gfc_expr *e = *ep;
    1905                 :             : 
    1906                 :        4806 :   if (e->expr_type == EXPR_VARIABLE && e->symtree
    1907                 :         177 :       && e->symtree->n.sym->attr.dummy)
    1908                 :         159 :     return e->symtree->n.sym->attr.intent != INTENT_IN;
    1909                 :             :   else
    1910                 :             :     return 0;
    1911                 :             : }
    1912                 :             : 
    1913                 :             : /* Auxiliary function to check if subexpressions have dummy variables which
    1914                 :             :    are not intent(in).
    1915                 :             : */
    1916                 :             : 
    1917                 :             : static bool
    1918                 :        4581 : dummy_intent_not_in (gfc_expr **ep)
    1919                 :             : {
    1920                 :           0 :   return gfc_expr_walker (ep, callback_dummy_intent_not_in, NULL);
    1921                 :             : }
    1922                 :             : 
    1923                 :             : /* Determine if an array ref, usually an array section specifies the
    1924                 :             :    entire array.  In addition, if the second, pointer argument is
    1925                 :             :    provided, the function will return true if the reference is
    1926                 :             :    contiguous; eg. (:, 1) gives true but (1,:) gives false.
    1927                 :             :    If one of the bounds depends on a dummy variable which is
    1928                 :             :    not INTENT(IN), also return false, because the user may
    1929                 :             :    have changed the variable.  */
    1930                 :             : 
    1931                 :             : bool
    1932                 :      161806 : gfc_full_array_ref_p (gfc_ref *ref, bool *contiguous)
    1933                 :             : {
    1934                 :      161806 :   int i;
    1935                 :      161806 :   int n;
    1936                 :      161806 :   bool lbound_OK = true;
    1937                 :      161806 :   bool ubound_OK = true;
    1938                 :             : 
    1939                 :      161806 :   if (contiguous)
    1940                 :       44315 :     *contiguous = false;
    1941                 :             : 
    1942                 :      161806 :   if (ref->type != REF_ARRAY)
    1943                 :             :     return false;
    1944                 :             : 
    1945                 :      161800 :   if (ref->u.ar.type == AR_FULL)
    1946                 :             :     {
    1947                 :      116513 :       if (contiguous)
    1948                 :       35045 :         *contiguous = true;
    1949                 :      116513 :       return true;
    1950                 :             :     }
    1951                 :             : 
    1952                 :       45287 :   if (ref->u.ar.type != AR_SECTION)
    1953                 :             :     return false;
    1954                 :       30333 :   if (ref->next)
    1955                 :             :     return false;
    1956                 :             : 
    1957                 :       56527 :   for (i = 0; i < ref->u.ar.dimen; i++)
    1958                 :             :     {
    1959                 :             :       /* If we have a single element in the reference, for the reference
    1960                 :             :          to be full, we need to ascertain that the array has a single
    1961                 :             :          element in this dimension and that we actually reference the
    1962                 :             :          correct element.  */
    1963                 :       40912 :       if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT)
    1964                 :             :         {
    1965                 :             :           /* This is unconditionally a contiguous reference if all the
    1966                 :             :              remaining dimensions are elements.  */
    1967                 :        3315 :           if (contiguous)
    1968                 :             :             {
    1969                 :         223 :               *contiguous = true;
    1970                 :         378 :               for (n = i + 1; n < ref->u.ar.dimen; n++)
    1971                 :         155 :                 if (ref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
    1972                 :         145 :                   *contiguous = false;
    1973                 :             :             }
    1974                 :             : 
    1975                 :        3346 :           if (!ref->u.ar.as
    1976                 :        3315 :               || !ref->u.ar.as->lower[i]
    1977                 :        2816 :               || !ref->u.ar.as->upper[i]
    1978                 :        2731 :               || gfc_dep_compare_expr (ref->u.ar.as->lower[i],
    1979                 :             :                                        ref->u.ar.as->upper[i])
    1980                 :          31 :               || !ref->u.ar.start[i]
    1981                 :        3346 :               || gfc_dep_compare_expr (ref->u.ar.start[i],
    1982                 :          31 :                                        ref->u.ar.as->lower[i]))
    1983                 :        3284 :             return false;
    1984                 :             :           else
    1985                 :          31 :             continue;
    1986                 :             :         }
    1987                 :             : 
    1988                 :             :       /* Check the lower bound.  */
    1989                 :       37597 :       if (ref->u.ar.start[i]
    1990                 :       37597 :           && (!ref->u.ar.as
    1991                 :       10671 :               || !ref->u.ar.as->lower[i]
    1992                 :        7406 :               || gfc_dep_compare_expr (ref->u.ar.start[i],
    1993                 :             :                                        ref->u.ar.as->lower[i])
    1994                 :        3000 :               || dummy_intent_not_in (&ref->u.ar.start[i])))
    1995                 :             :         lbound_OK = false;
    1996                 :             :       /* Check the upper bound.  */
    1997                 :       37597 :       if (ref->u.ar.end[i]
    1998                 :       37597 :           && (!ref->u.ar.as
    1999                 :       10548 :               || !ref->u.ar.as->upper[i]
    2000                 :        6982 :               || gfc_dep_compare_expr (ref->u.ar.end[i],
    2001                 :             :                                        ref->u.ar.as->upper[i])
    2002                 :        1581 :               || dummy_intent_not_in (&ref->u.ar.end[i])))
    2003                 :             :         ubound_OK = false;
    2004                 :             :       /* Check the stride.  */
    2005                 :       37597 :       if (ref->u.ar.stride[i]
    2006                 :       37597 :             && !gfc_expr_is_one (ref->u.ar.stride[i], 0))
    2007                 :             :         return false;
    2008                 :             : 
    2009                 :             :       /* This is unconditionally a contiguous reference as long as all
    2010                 :             :          the subsequent dimensions are elements.  */
    2011                 :       35061 :       if (contiguous)
    2012                 :             :         {
    2013                 :       12965 :           *contiguous = true;
    2014                 :       19223 :           for (n = i + 1; n < ref->u.ar.dimen; n++)
    2015                 :        6258 :             if (ref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
    2016                 :        6098 :               *contiguous = false;
    2017                 :             :         }
    2018                 :             : 
    2019                 :       35061 :       if (!lbound_OK || !ubound_OK)
    2020                 :             :         return false;
    2021                 :             :     }
    2022                 :             :   return true;
    2023                 :             : }
    2024                 :             : 
    2025                 :             : 
    2026                 :             : /* Determine if a full array is the same as an array section with one
    2027                 :             :    variable limit.  For this to be so, the strides must both be unity
    2028                 :             :    and one of either start == lower or end == upper must be true.  */
    2029                 :             : 
    2030                 :             : static bool
    2031                 :       11254 : ref_same_as_full_array (gfc_ref *full_ref, gfc_ref *ref)
    2032                 :             : {
    2033                 :       11254 :   int i;
    2034                 :       11254 :   bool upper_or_lower;
    2035                 :             : 
    2036                 :       11254 :   if (full_ref->type != REF_ARRAY)
    2037                 :             :     return false;
    2038                 :       11254 :   if (full_ref->u.ar.type != AR_FULL)
    2039                 :             :     return false;
    2040                 :        4184 :   if (ref->type != REF_ARRAY)
    2041                 :             :     return false;
    2042                 :        4184 :   if (ref->u.ar.type == AR_FULL)
    2043                 :             :     return true;
    2044                 :         486 :   if (ref->u.ar.type != AR_SECTION)
    2045                 :             :     return false;
    2046                 :             : 
    2047                 :         445 :   for (i = 0; i < ref->u.ar.dimen; i++)
    2048                 :             :     {
    2049                 :             :       /* If we have a single element in the reference, we need to check
    2050                 :             :          that the array has a single element and that we actually reference
    2051                 :             :          the correct element.  */
    2052                 :         413 :       if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT)
    2053                 :             :         {
    2054                 :          13 :           if (!full_ref->u.ar.as
    2055                 :          13 :               || !full_ref->u.ar.as->lower[i]
    2056                 :          13 :               || !full_ref->u.ar.as->upper[i]
    2057                 :          13 :               || gfc_dep_compare_expr (full_ref->u.ar.as->lower[i],
    2058                 :             :                                        full_ref->u.ar.as->upper[i])
    2059                 :           0 :               || !ref->u.ar.start[i]
    2060                 :          13 :               || gfc_dep_compare_expr (ref->u.ar.start[i],
    2061                 :           0 :                                        full_ref->u.ar.as->lower[i]))
    2062                 :          13 :             return false;
    2063                 :             :         }
    2064                 :             : 
    2065                 :             :       /* Check the strides.  */
    2066                 :         400 :       if (full_ref->u.ar.stride[i] && !gfc_expr_is_one (full_ref->u.ar.stride[i], 0))
    2067                 :             :         return false;
    2068                 :         400 :       if (ref->u.ar.stride[i] && !gfc_expr_is_one (ref->u.ar.stride[i], 0))
    2069                 :             :         return false;
    2070                 :             : 
    2071                 :         311 :       upper_or_lower = false;
    2072                 :             :       /* Check the lower bound.  */
    2073                 :         311 :       if (ref->u.ar.start[i]
    2074                 :         311 :           && (ref->u.ar.as
    2075                 :         136 :                 && full_ref->u.ar.as->lower[i]
    2076                 :          68 :                 && gfc_dep_compare_expr (ref->u.ar.start[i],
    2077                 :             :                                          full_ref->u.ar.as->lower[i]) == 0))
    2078                 :             :         upper_or_lower =  true;
    2079                 :             :       /* Check the upper bound.  */
    2080                 :         311 :       if (ref->u.ar.end[i]
    2081                 :         311 :           && (ref->u.ar.as
    2082                 :          85 :                 && full_ref->u.ar.as->upper[i]
    2083                 :          61 :                 && gfc_dep_compare_expr (ref->u.ar.end[i],
    2084                 :             :                                          full_ref->u.ar.as->upper[i]) == 0))
    2085                 :             :         upper_or_lower =  true;
    2086                 :         306 :       if (!upper_or_lower)
    2087                 :             :         return false;
    2088                 :             :     }
    2089                 :             :   return true;
    2090                 :             : }
    2091                 :             : 
    2092                 :             : 
    2093                 :             : /* Finds if two array references are overlapping or not.
    2094                 :             :    Return value
    2095                 :             :         1 : array references are overlapping, or identical is true and
    2096                 :             :             there is some kind of overlap.
    2097                 :             :         0 : array references are identical or not overlapping.  */
    2098                 :             : 
    2099                 :             : bool
    2100                 :        7528 : gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse,
    2101                 :             :                   bool identical)
    2102                 :             : {
    2103                 :        7528 :   int n;
    2104                 :        7528 :   int m;
    2105                 :        7528 :   gfc_dependency fin_dep;
    2106                 :        7528 :   gfc_dependency this_dep;
    2107                 :        7528 :   bool same_component = false;
    2108                 :             : 
    2109                 :        7528 :   this_dep = GFC_DEP_ERROR;
    2110                 :        7528 :   fin_dep = GFC_DEP_ERROR;
    2111                 :             :   /* Dependencies due to pointers should already have been identified.
    2112                 :             :      We only need to check for overlapping array references.  */
    2113                 :             : 
    2114                 :        9479 :   while (lref && rref)
    2115                 :             :     {
    2116                 :             :       /* The refs might come in mixed, one with a _data component and one
    2117                 :             :          without.  Look at their next reference in order to avoid an
    2118                 :             :          ICE.  */
    2119                 :             : 
    2120                 :        8061 :       if (lref && lref->type == REF_COMPONENT && lref->u.c.component
    2121                 :         487 :           && strcmp (lref->u.c.component->name, "_data") == 0)
    2122                 :         104 :         lref = lref->next;
    2123                 :             : 
    2124                 :        8061 :       if (rref && rref->type == REF_COMPONENT && rref->u.c.component
    2125                 :         449 :           && strcmp (rref->u.c.component->name, "_data") == 0)
    2126                 :          66 :         rref = rref->next;
    2127                 :             : 
    2128                 :             :       /* We're resolving from the same base symbol, so both refs should be
    2129                 :             :          the same type.  We traverse the reference chain until we find ranges
    2130                 :             :          that are not equal.  */
    2131                 :        8061 :       gcc_assert (lref->type == rref->type);
    2132                 :        8061 :       switch (lref->type)
    2133                 :             :         {
    2134                 :         383 :         case REF_COMPONENT:
    2135                 :             :           /* The two ranges can't overlap if they are from different
    2136                 :             :              components.  */
    2137                 :         383 :           if (lref->u.c.component != rref->u.c.component)
    2138                 :             :             return 0;
    2139                 :             : 
    2140                 :             :           same_component = true;
    2141                 :             :           break;
    2142                 :             : 
    2143                 :         104 :         case REF_SUBSTRING:
    2144                 :             :           /* Substring overlaps are handled by the string assignment code
    2145                 :             :              if there is not an underlying dependency.  */
    2146                 :         104 :           return (fin_dep == GFC_DEP_OVERLAP) ? 1 : 0;
    2147                 :             : 
    2148                 :        7556 :         case REF_ARRAY:
    2149                 :             :           /* Coarrays: If there is a coindex, either the image differs and there
    2150                 :             :              is no overlap or the image is the same - then the normal analysis
    2151                 :             :              applies.  Hence, return early if either ref is coindexed and more
    2152                 :             :              than one image can exist.  */
    2153                 :        7556 :           if (flag_coarray != GFC_FCOARRAY_SINGLE
    2154                 :        7412 :               && ((lref->u.ar.codimen
    2155                 :         138 :                    && lref->u.ar.dimen_type[lref->u.ar.dimen]
    2156                 :             :                       != DIMEN_THIS_IMAGE)
    2157                 :        7412 :                   || (rref->u.ar.codimen
    2158                 :             :                       && lref->u.ar.dimen_type[lref->u.ar.dimen]
    2159                 :             :                          != DIMEN_THIS_IMAGE)))
    2160                 :             :             return 1;
    2161                 :        7500 :           if (lref->u.ar.dimen == 0 || rref->u.ar.dimen == 0)
    2162                 :             :             {
    2163                 :             :               /* Coindexed scalar coarray with GFC_FCOARRAY_SINGLE.  */
    2164                 :          18 :               if (lref->u.ar.dimen || rref->u.ar.dimen)
    2165                 :             :                 return 1;  /* Just to be sure.  */
    2166                 :             :               fin_dep = GFC_DEP_EQUAL;
    2167                 :             :               break;
    2168                 :             :             }
    2169                 :             : 
    2170                 :        7482 :           if (ref_same_as_full_array (lref, rref))
    2171                 :             :             return identical;
    2172                 :             : 
    2173                 :        3772 :           if (ref_same_as_full_array (rref, lref))
    2174                 :             :             return identical;
    2175                 :             : 
    2176                 :        3752 :           if (lref->u.ar.dimen != rref->u.ar.dimen)
    2177                 :             :             {
    2178                 :           0 :               if (lref->u.ar.type == AR_FULL)
    2179                 :           0 :                 fin_dep = gfc_full_array_ref_p (rref, NULL) ? GFC_DEP_EQUAL
    2180                 :             :                                                             : GFC_DEP_OVERLAP;
    2181                 :           0 :               else if (rref->u.ar.type == AR_FULL)
    2182                 :           0 :                 fin_dep = gfc_full_array_ref_p (lref, NULL) ? GFC_DEP_EQUAL
    2183                 :             :                                                             : GFC_DEP_OVERLAP;
    2184                 :             :               else
    2185                 :             :                 return 1;
    2186                 :             :               break;
    2187                 :             :             }
    2188                 :             : 
    2189                 :             :           /* Index for the reverse array.  */
    2190                 :             :           m = -1;
    2191                 :        6710 :           for (n = 0; n < lref->u.ar.dimen; n++)
    2192                 :             :             {
    2193                 :             :               /* Handle dependency when either of array reference is vector
    2194                 :             :                  subscript. There is no dependency if the vector indices
    2195                 :             :                  are equal or if indices are known to be different in a
    2196                 :             :                  different dimension.  */
    2197                 :        4611 :               if (lref->u.ar.dimen_type[n] == DIMEN_VECTOR
    2198                 :        4551 :                   || rref->u.ar.dimen_type[n] == DIMEN_VECTOR)
    2199                 :             :                 {
    2200                 :         117 :                   if (lref->u.ar.dimen_type[n] == DIMEN_VECTOR
    2201                 :          60 :                       && rref->u.ar.dimen_type[n] == DIMEN_VECTOR
    2202                 :         177 :                       && gfc_dep_compare_expr (lref->u.ar.start[n],
    2203                 :             :                                                rref->u.ar.start[n]) == 0)
    2204                 :             :                     this_dep = GFC_DEP_EQUAL;
    2205                 :             :                   else
    2206                 :             :                     this_dep = GFC_DEP_OVERLAP;
    2207                 :             : 
    2208                 :         117 :                   goto update_fin_dep;
    2209                 :             :                 }
    2210                 :             : 
    2211                 :        4494 :               if (lref->u.ar.dimen_type[n] == DIMEN_RANGE
    2212                 :        2209 :                   && rref->u.ar.dimen_type[n] == DIMEN_RANGE)
    2213                 :        2061 :                 this_dep = check_section_vs_section (&lref->u.ar,
    2214                 :             :                                                      &rref->u.ar, n);
    2215                 :        2433 :               else if (lref->u.ar.dimen_type[n] == DIMEN_ELEMENT
    2216                 :        2285 :                        && rref->u.ar.dimen_type[n] == DIMEN_RANGE)
    2217                 :          82 :                 this_dep = gfc_check_element_vs_section (lref, rref, n);
    2218                 :        2351 :               else if (rref->u.ar.dimen_type[n] == DIMEN_ELEMENT
    2219                 :        2351 :                        && lref->u.ar.dimen_type[n] == DIMEN_RANGE)
    2220                 :         148 :                 this_dep = gfc_check_element_vs_section (rref, lref, n);
    2221                 :             :               else
    2222                 :             :                 {
    2223                 :        2203 :                   gcc_assert (rref->u.ar.dimen_type[n] == DIMEN_ELEMENT
    2224                 :             :                               && lref->u.ar.dimen_type[n] == DIMEN_ELEMENT);
    2225                 :        2203 :                   this_dep = gfc_check_element_vs_element (rref, lref, n);
    2226                 :        2203 :                   if (identical && this_dep == GFC_DEP_EQUAL)
    2227                 :             :                     this_dep = GFC_DEP_OVERLAP;
    2228                 :             :                 }
    2229                 :             : 
    2230                 :             :               /* If any dimension doesn't overlap, we have no dependency.  */
    2231                 :        4354 :               if (this_dep == GFC_DEP_NODEP)
    2232                 :             :                 return 0;
    2233                 :             : 
    2234                 :             :               /* Now deal with the loop reversal logic:  This only works on
    2235                 :             :                  ranges and is activated by setting
    2236                 :             :                                 reverse[n] == GFC_ENABLE_REVERSE
    2237                 :             :                  The ability to reverse or not is set by previous conditions
    2238                 :             :                  in this dimension.  If reversal is not activated, the
    2239                 :             :                  value GFC_DEP_BACKWARD is reset to GFC_DEP_OVERLAP.  */
    2240                 :             : 
    2241                 :             :               /* Get the indexing right for the scalarizing loop. If this
    2242                 :             :                  is an element, there is no corresponding loop.  */
    2243                 :        2841 :               if (lref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
    2244                 :        2100 :                 m++;
    2245                 :             : 
    2246                 :        2841 :               if (rref->u.ar.dimen_type[n] == DIMEN_RANGE
    2247                 :        2035 :                     && lref->u.ar.dimen_type[n] == DIMEN_RANGE)
    2248                 :             :                 {
    2249                 :        1953 :                   if (reverse)
    2250                 :             :                     {
    2251                 :             :                       /* Reverse if backward dependence and not inhibited.  */
    2252                 :         746 :                       if (reverse[m] == GFC_ENABLE_REVERSE
    2253                 :         694 :                           && this_dep == GFC_DEP_BACKWARD)
    2254                 :          86 :                         reverse[m] = GFC_REVERSE_SET;
    2255                 :             : 
    2256                 :             :                       /* Forward if forward dependence and not inhibited.  */
    2257                 :         746 :                       if (reverse[m] == GFC_ENABLE_REVERSE
    2258                 :         608 :                           && this_dep == GFC_DEP_FORWARD)
    2259                 :          97 :                         reverse[m] = GFC_FORWARD_SET;
    2260                 :             : 
    2261                 :             :                       /* Flag up overlap if dependence not compatible with
    2262                 :             :                          the overall state of the expression.  */
    2263                 :         746 :                       if (reverse[m] == GFC_REVERSE_SET
    2264                 :         108 :                           && this_dep == GFC_DEP_FORWARD)
    2265                 :             :                         {
    2266                 :          16 :                           reverse[m] = GFC_INHIBIT_REVERSE;
    2267                 :          16 :                           this_dep = GFC_DEP_OVERLAP;
    2268                 :             :                         }
    2269                 :         730 :                       else if (reverse[m] == GFC_FORWARD_SET
    2270                 :         103 :                                && this_dep == GFC_DEP_BACKWARD)
    2271                 :             :                         {
    2272                 :           6 :                           reverse[m] = GFC_INHIBIT_REVERSE;
    2273                 :           6 :                           this_dep = GFC_DEP_OVERLAP;
    2274                 :             :                         }
    2275                 :             :                     }
    2276                 :             : 
    2277                 :             :                   /* If no intention of reversing or reversing is explicitly
    2278                 :             :                      inhibited, convert backward dependence to overlap.  */
    2279                 :        1953 :                   if ((!reverse && this_dep == GFC_DEP_BACKWARD)
    2280                 :        1806 :                       || (reverse && reverse[m] == GFC_INHIBIT_REVERSE))
    2281                 :        2958 :                     this_dep = GFC_DEP_OVERLAP;
    2282                 :             :                 }
    2283                 :             : 
    2284                 :             :               /* Overlap codes are in order of priority.  We only need to
    2285                 :             :                  know the worst one.*/
    2286                 :             : 
    2287                 :         888 :             update_fin_dep:
    2288                 :        2958 :               if (identical && this_dep == GFC_DEP_EQUAL)
    2289                 :         540 :                 this_dep = GFC_DEP_OVERLAP;
    2290                 :             : 
    2291                 :        2958 :               if (this_dep > fin_dep)
    2292                 :        2119 :                 fin_dep = this_dep;
    2293                 :             :             }
    2294                 :             : 
    2295                 :             :           /* If this is an equal element, we have to keep going until we find
    2296                 :             :              the "real" array reference.  */
    2297                 :        2099 :           if (lref->u.ar.type == AR_ELEMENT
    2298                 :         222 :                 && rref->u.ar.type == AR_ELEMENT
    2299                 :         222 :                 && fin_dep == GFC_DEP_EQUAL)
    2300                 :             :             break;
    2301                 :             : 
    2302                 :             :           /* Exactly matching and forward overlapping ranges don't cause a
    2303                 :             :              dependency.  */
    2304                 :        2024 :           if (fin_dep < GFC_DEP_BACKWARD && !identical)
    2305                 :             :             return 0;
    2306                 :             : 
    2307                 :             :           /* Keep checking.  We only have a dependency if
    2308                 :             :              subsequent references also overlap.  */
    2309                 :             :           break;
    2310                 :             : 
    2311                 :          18 :         case REF_INQUIRY:
    2312                 :          18 :           if (lref->u.i != rref->u.i)
    2313                 :             :             return 0;
    2314                 :             : 
    2315                 :             :           break;
    2316                 :             : 
    2317                 :           0 :         default:
    2318                 :           0 :           gcc_unreachable ();
    2319                 :             :         }
    2320                 :        1951 :       lref = lref->next;
    2321                 :        1951 :       rref = rref->next;
    2322                 :             :     }
    2323                 :             : 
    2324                 :             :   /* Assume the worst if we nest to different depths.  */
    2325                 :        1418 :   if (lref || rref)
    2326                 :             :     return 1;
    2327                 :             : 
    2328                 :             :   /* This can result from concatenation of assumed length string components.  */
    2329                 :        1356 :   if (same_component && fin_dep == GFC_DEP_ERROR)
    2330                 :             :     return 1;
    2331                 :             : 
    2332                 :             :   /* If we haven't seen any array refs then something went wrong.  */
    2333                 :        1344 :   gcc_assert (fin_dep != GFC_DEP_ERROR);
    2334                 :             : 
    2335                 :        1344 :   if (identical && fin_dep != GFC_DEP_NODEP)
    2336                 :             :     return 1;
    2337                 :             : 
    2338                 :         577 :   return fin_dep == GFC_DEP_OVERLAP;
    2339                 :             : }
        

Generated by: LCOV version 2.0-1

LCOV profile is generated on x86_64 machine using following configure options: configure --disable-bootstrap --enable-coverage=opt --enable-languages=c,c++,fortran,go,jit,lto,rust,m2 --enable-host-shared. GCC test suite is run with the built compiler.