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

Generated by: LCOV version 1.0

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 --enable-host-shared. GCC test suite is run with the built compiler.