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

Generated by: LCOV version 2.1-beta

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