LCOV - code coverage report
Current view: top level - gcc/fortran - matchexp.cc (source / functions) Coverage Total Hit
Test: gcc.info Lines: 85.5 % 442 378
Test Date: 2024-03-23 14:05:01 Functions: 100.0 % 19 19
Legend: Lines: hit not hit | Branches: + taken - not taken # not executed Branches: - 0 0

             Branch data     Line data    Source code
       1                 :             : /* Expression parser.
       2                 :             :    Copyright (C) 2000-2024 Free Software Foundation, Inc.
       3                 :             :    Contributed by Andy Vaught
       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                 :             : #include "config.h"
      22                 :             : #include "system.h"
      23                 :             : #include "coretypes.h"
      24                 :             : #include "gfortran.h"
      25                 :             : #include "arith.h"
      26                 :             : #include "match.h"
      27                 :             : 
      28                 :             : static const char expression_syntax[] = N_("Syntax error in expression at %C");
      29                 :             : 
      30                 :             : 
      31                 :             : /* Match a user-defined operator name.  This is a normal name with a
      32                 :             :    few restrictions.  The error_flag controls whether an error is
      33                 :             :    raised if 'true' or 'false' are used or not.  */
      34                 :             : 
      35                 :             : match
      36                 :     9820888 : gfc_match_defined_op_name (char *result, int error_flag)
      37                 :             : {
      38                 :     9820888 :   static const char * const badops[] = {
      39                 :             :     "and", "or", "not", "eqv", "neqv", "eq", "ne", "ge", "le", "lt", "gt",
      40                 :             :       NULL
      41                 :             :   };
      42                 :             : 
      43                 :     9820888 :   char name[GFC_MAX_SYMBOL_LEN + 1];
      44                 :     9820888 :   locus old_loc;
      45                 :     9820888 :   match m;
      46                 :     9820888 :   int i;
      47                 :             : 
      48                 :     9820888 :   old_loc = gfc_current_locus;
      49                 :             : 
      50                 :     9820888 :   m = gfc_match (" . %n .", name);
      51                 :     9820888 :   if (m != MATCH_YES)
      52                 :             :     return m;
      53                 :             : 
      54                 :             :   /* .true. and .false. have interpretations as constants.  Trying to
      55                 :             :      use these as operators will fail at a later time.  */
      56                 :             : 
      57                 :       39113 :   if (strcmp (name, "true") == 0 || strcmp (name, "false") == 0)
      58                 :             :     {
      59                 :       38277 :       if (error_flag)
      60                 :           0 :         goto error;
      61                 :       38277 :       gfc_current_locus = old_loc;
      62                 :       38277 :       return MATCH_NO;
      63                 :             :     }
      64                 :             : 
      65                 :       10031 :   for (i = 0; badops[i]; i++)
      66                 :        9196 :     if (strcmp (badops[i], name) == 0)
      67                 :           1 :       goto error;
      68                 :             : 
      69                 :        4398 :   for (i = 0; name[i]; i++)
      70                 :        3599 :     if (!ISALPHA (name[i]))
      71                 :             :       {
      72                 :          36 :         gfc_error ("Bad character %qc in OPERATOR name at %C", name[i]);
      73                 :          36 :         return MATCH_ERROR;
      74                 :             :       }
      75                 :             : 
      76                 :         799 :   strcpy (result, name);
      77                 :         799 :   return MATCH_YES;
      78                 :             : 
      79                 :           1 : error:
      80                 :           1 :   gfc_error ("The name %qs cannot be used as a defined operator at %C",
      81                 :             :              name);
      82                 :             : 
      83                 :           1 :   gfc_current_locus = old_loc;
      84                 :           1 :   return MATCH_ERROR;
      85                 :             : }
      86                 :             : 
      87                 :             : 
      88                 :             : /* Match a user defined operator.  The symbol found must be an
      89                 :             :    operator already.  */
      90                 :             : 
      91                 :             : static match
      92                 :     9819461 : match_defined_operator (gfc_user_op **result)
      93                 :             : {
      94                 :     9819461 :   char name[GFC_MAX_SYMBOL_LEN + 1];
      95                 :     9819461 :   match m;
      96                 :             : 
      97                 :     9819461 :   m = gfc_match_defined_op_name (name, 0);
      98                 :     9819461 :   if (m != MATCH_YES)
      99                 :             :     return m;
     100                 :             : 
     101                 :         404 :   *result = gfc_get_uop (name);
     102                 :         404 :   return MATCH_YES;
     103                 :             : }
     104                 :             : 
     105                 :             : 
     106                 :             : /* Check to see if the given operator is next on the input.  If this
     107                 :             :    is not the case, the parse pointer remains where it was.  */
     108                 :             : 
     109                 :             : static int
     110                 :    62919077 : next_operator (gfc_intrinsic_op t)
     111                 :             : {
     112                 :    62919077 :   gfc_intrinsic_op u;
     113                 :    62919077 :   locus old_loc;
     114                 :             : 
     115                 :    62919077 :   old_loc = gfc_current_locus;
     116                 :    62919077 :   if (gfc_match_intrinsic_op (&u) == MATCH_YES && t == u)
     117                 :             :     return 1;
     118                 :             : 
     119                 :    62335826 :   gfc_current_locus = old_loc;
     120                 :    62335826 :   return 0;
     121                 :             : }
     122                 :             : 
     123                 :             : 
     124                 :             : /* Call the INTRINSIC_PARENTHESES function.  This is both
     125                 :             :    used explicitly, as below, or by resolve.cc to generate
     126                 :             :    temporaries.  */
     127                 :             : 
     128                 :             : gfc_expr *
     129                 :       53965 : gfc_get_parentheses (gfc_expr *e)
     130                 :             : {
     131                 :       53965 :   gfc_expr *e2;
     132                 :             : 
     133                 :       53965 :   e2 = gfc_get_operator_expr (&e->where, INTRINSIC_PARENTHESES, e, NULL);
     134                 :       53965 :   e2->ts = e->ts;
     135                 :       53965 :   e2->rank = e->rank;
     136                 :             : 
     137                 :       53965 :   return e2;
     138                 :             : }
     139                 :             : 
     140                 :             : 
     141                 :             : /* Match a primary expression.  */
     142                 :             : 
     143                 :             : static match
     144                 :     5757169 : match_primary (gfc_expr **result)
     145                 :             : {
     146                 :     5757169 :   match m;
     147                 :     5757169 :   gfc_expr *e;
     148                 :             : 
     149                 :     5757169 :   m = gfc_match_literal_constant (result, 0);
     150                 :     5757169 :   if (m != MATCH_NO)
     151                 :             :     return m;
     152                 :             : 
     153                 :     3443224 :   m = gfc_match_array_constructor (result);
     154                 :     3443224 :   if (m != MATCH_NO)
     155                 :             :     return m;
     156                 :             : 
     157                 :     3340396 :   m = gfc_match_rvalue (result);
     158                 :     3340396 :   if (m != MATCH_NO)
     159                 :             :     return m;
     160                 :             : 
     161                 :             :   /* Match an expression in parentheses.  */
     162                 :      170005 :   if (gfc_match_char ('(') != MATCH_YES)
     163                 :             :     return MATCH_NO;
     164                 :             : 
     165                 :       53678 :   m = gfc_match_expr (&e);
     166                 :       53678 :   if (m == MATCH_NO)
     167                 :          65 :     goto syntax;
     168                 :       53613 :   if (m == MATCH_ERROR)
     169                 :             :     return m;
     170                 :             : 
     171                 :       53609 :   m = gfc_match_char (')');
     172                 :       53609 :   if (m == MATCH_NO)
     173                 :        2269 :     gfc_error ("Expected a right parenthesis in expression at %C");
     174                 :             : 
     175                 :             :   /* Now we have the expression inside the parentheses, build the
     176                 :             :      expression pointing to it. By 7.1.7.2, any expression in
     177                 :             :      parentheses shall be treated as a data entity.  */
     178                 :       53609 :   *result = gfc_get_parentheses (e);
     179                 :             : 
     180                 :       53609 :   if (m != MATCH_YES)
     181                 :             :     {
     182                 :        2269 :       gfc_free_expr (*result);
     183                 :        2269 :       return MATCH_ERROR;
     184                 :             :     }
     185                 :             : 
     186                 :             :   return MATCH_YES;
     187                 :             : 
     188                 :          65 : syntax:
     189                 :          65 :   gfc_error (expression_syntax);
     190                 :          65 :   return MATCH_ERROR;
     191                 :             : }
     192                 :             : 
     193                 :             : 
     194                 :             : /* Match a level 1 expression.  */
     195                 :             : 
     196                 :             : static match
     197                 :     5757169 : match_level_1 (gfc_expr **result)
     198                 :             : {
     199                 :     5757169 :   gfc_user_op *uop;
     200                 :     5757169 :   gfc_expr *e, *f;
     201                 :     5757169 :   locus where;
     202                 :     5757169 :   match m;
     203                 :             : 
     204                 :     5757169 :   gfc_gobble_whitespace ();
     205                 :     5757169 :   where = gfc_current_locus;
     206                 :     5757169 :   uop = NULL;
     207                 :     5757169 :   m = match_defined_operator (&uop);
     208                 :     5757169 :   if (m == MATCH_ERROR)
     209                 :             :     return m;
     210                 :             : 
     211                 :     5757169 :   m = match_primary (&e);
     212                 :     5757169 :   if (m != MATCH_YES)
     213                 :             :     return m;
     214                 :             : 
     215                 :     5081620 :   if (uop == NULL)
     216                 :     5081396 :     *result = e;
     217                 :             :   else
     218                 :             :     {
     219                 :         224 :       f = gfc_get_operator_expr (&where, INTRINSIC_USER, e, NULL);
     220                 :         224 :       f->value.op.uop = uop;
     221                 :         224 :       *result = f;
     222                 :             :     }
     223                 :             : 
     224                 :             :   return MATCH_YES;
     225                 :             : }
     226                 :             : 
     227                 :             : 
     228                 :             : /* As a GNU extension we support an expanded level-2 expression syntax.
     229                 :             :    Via this extension we support (arbitrary) nesting of unary plus and
     230                 :             :    minus operations following unary and binary operators, such as **.
     231                 :             :    The grammar of section 7.1.1.3 is effectively rewritten as:
     232                 :             : 
     233                 :             :         R704  mult-operand     is level-1-expr [ power-op ext-mult-operand ]
     234                 :             :         R704' ext-mult-operand is add-op ext-mult-operand
     235                 :             :                                or mult-operand
     236                 :             :         R705  add-operand      is add-operand mult-op ext-mult-operand
     237                 :             :                                or mult-operand
     238                 :             :         R705' ext-add-operand  is add-op ext-add-operand
     239                 :             :                                or add-operand
     240                 :             :         R706  level-2-expr     is [ level-2-expr ] add-op ext-add-operand
     241                 :             :                                or add-operand
     242                 :             :  */
     243                 :             : 
     244                 :             : static match match_ext_mult_operand (gfc_expr **result);
     245                 :             : static match match_ext_add_operand (gfc_expr **result);
     246                 :             : 
     247                 :             : static int
     248                 :    10888768 : match_add_op (void)
     249                 :             : {
     250                 :    10888768 :   if (next_operator (INTRINSIC_MINUS))
     251                 :             :     return -1;
     252                 :    10688176 :   if (next_operator (INTRINSIC_PLUS))
     253                 :       64890 :     return 1;
     254                 :             :   return 0;
     255                 :             : }
     256                 :             : 
     257                 :             : 
     258                 :             : static match
     259                 :     5757169 : match_mult_operand (gfc_expr **result)
     260                 :             : {
     261                 :             :   /* Workaround -Wmaybe-uninitialized false positive during
     262                 :             :      profiledbootstrap by initializing them.  */
     263                 :     5757169 :   gfc_expr *e = NULL, *exp, *r;
     264                 :     5757169 :   locus where;
     265                 :     5757169 :   match m;
     266                 :             : 
     267                 :     5757169 :   m = match_level_1 (&e);
     268                 :     5757169 :   if (m != MATCH_YES)
     269                 :             :     return m;
     270                 :             : 
     271                 :     5081620 :   if (!next_operator (INTRINSIC_POWER))
     272                 :             :     {
     273                 :     5074737 :       *result = e;
     274                 :     5074737 :       return MATCH_YES;
     275                 :             :     }
     276                 :             : 
     277                 :        6883 :   where = gfc_current_locus;
     278                 :             : 
     279                 :        6883 :   m = match_ext_mult_operand (&exp);
     280                 :        6883 :   if (m == MATCH_NO)
     281                 :           0 :     gfc_error ("Expected exponent in expression at %C");
     282                 :        6883 :   if (m != MATCH_YES)
     283                 :             :     {
     284                 :           1 :       gfc_free_expr (e);
     285                 :           1 :       return MATCH_ERROR;
     286                 :             :     }
     287                 :             : 
     288                 :        6882 :   r = gfc_power (e, exp);
     289                 :        6882 :   if (r == NULL)
     290                 :             :     {
     291                 :           0 :       gfc_free_expr (e);
     292                 :           0 :       gfc_free_expr (exp);
     293                 :           0 :       return MATCH_ERROR;
     294                 :             :     }
     295                 :             : 
     296                 :        6882 :   r->where = where;
     297                 :        6882 :   *result = r;
     298                 :             : 
     299                 :        6882 :   return MATCH_YES;
     300                 :             : }
     301                 :             : 
     302                 :             : 
     303                 :             : static match
     304                 :      127277 : match_ext_mult_operand (gfc_expr **result)
     305                 :             : {
     306                 :      127277 :   gfc_expr *all, *e;
     307                 :      127277 :   locus where;
     308                 :      127277 :   match m;
     309                 :      127277 :   int i;
     310                 :             : 
     311                 :      127277 :   where = gfc_current_locus;
     312                 :      127277 :   i = match_add_op ();
     313                 :             : 
     314                 :      127277 :   if (i == 0)
     315                 :      127264 :     return match_mult_operand (result);
     316                 :             : 
     317                 :          13 :   if (gfc_notification_std (GFC_STD_GNU) == ERROR)
     318                 :             :     {
     319                 :           0 :       gfc_error ("Extension: Unary operator following "
     320                 :             :                  "arithmetic operator (use parentheses) at %C");
     321                 :           0 :       return MATCH_ERROR;
     322                 :             :     }
     323                 :             :   else
     324                 :          13 :     gfc_warning (0, "Extension: Unary operator following "
     325                 :             :                  "arithmetic operator (use parentheses) at %C");
     326                 :             : 
     327                 :          13 :   m = match_ext_mult_operand (&e);
     328                 :          13 :   if (m != MATCH_YES)
     329                 :             :     return m;
     330                 :             : 
     331                 :          13 :   if (i == -1)
     332                 :           7 :     all = gfc_uminus (e);
     333                 :             :   else
     334                 :           6 :     all = gfc_uplus (e);
     335                 :             : 
     336                 :          13 :   if (all == NULL)
     337                 :             :     {
     338                 :           0 :       gfc_free_expr (e);
     339                 :           0 :       return MATCH_ERROR;
     340                 :             :     }
     341                 :             : 
     342                 :          13 :   all->where = where;
     343                 :          13 :   *result = all;
     344                 :          13 :   return MATCH_YES;
     345                 :             : }
     346                 :             : 
     347                 :             : 
     348                 :             : static match
     349                 :     5629905 : match_add_operand (gfc_expr **result)
     350                 :             : {
     351                 :     5629905 :   gfc_expr *all, *e, *total;
     352                 :     5629905 :   locus where, old_loc;
     353                 :     5629905 :   match m;
     354                 :     5629905 :   gfc_intrinsic_op i;
     355                 :             : 
     356                 :     5629905 :   m = match_mult_operand (&all);
     357                 :     5629905 :   if (m != MATCH_YES)
     358                 :             :     return m;
     359                 :             : 
     360                 :     5151582 :   for (;;)
     361                 :             :     {
     362                 :             :       /* Build up a string of products or quotients.  */
     363                 :             : 
     364                 :     5074729 :       old_loc = gfc_current_locus;
     365                 :             : 
     366                 :     5074729 :       if (next_operator (INTRINSIC_TIMES))
     367                 :             :         i = INTRINSIC_TIMES;
     368                 :             :       else
     369                 :             :         {
     370                 :     5010303 :           if (next_operator (INTRINSIC_DIVIDE))
     371                 :             :             i = INTRINSIC_DIVIDE;
     372                 :             :           else
     373                 :             :             break;
     374                 :             :         }
     375                 :             : 
     376                 :      120381 :       where = gfc_current_locus;
     377                 :             : 
     378                 :      120381 :       m = match_ext_mult_operand (&e);
     379                 :      120381 :       if (m == MATCH_NO)
     380                 :             :         {
     381                 :       43520 :           gfc_current_locus = old_loc;
     382                 :       43520 :           break;
     383                 :             :         }
     384                 :             : 
     385                 :       76861 :       if (m == MATCH_ERROR)
     386                 :             :         {
     387                 :           0 :           gfc_free_expr (all);
     388                 :           0 :           return MATCH_ERROR;
     389                 :             :         }
     390                 :             : 
     391                 :       76861 :       if (i == INTRINSIC_TIMES)
     392                 :       64426 :         total = gfc_multiply (all, e);
     393                 :             :       else
     394                 :       12435 :         total = gfc_divide (all, e);
     395                 :             : 
     396                 :       76861 :       if (total == NULL)
     397                 :             :         {
     398                 :           8 :           gfc_free_expr (all);
     399                 :           8 :           gfc_free_expr (e);
     400                 :           8 :           return MATCH_ERROR;
     401                 :             :         }
     402                 :             : 
     403                 :       76853 :       all = total;
     404                 :       76853 :       all->where = where;
     405                 :             :     }
     406                 :             : 
     407                 :     4997868 :   *result = all;
     408                 :     4997868 :   return MATCH_YES;
     409                 :             : }
     410                 :             : 
     411                 :             : 
     412                 :             : static match
     413                 :      265469 : match_ext_add_operand (gfc_expr **result)
     414                 :             : {
     415                 :      265469 :   gfc_expr *all, *e;
     416                 :      265469 :   locus where;
     417                 :      265469 :   match m;
     418                 :      265469 :   int i;
     419                 :             : 
     420                 :      265469 :   where = gfc_current_locus;
     421                 :      265469 :   i = match_add_op ();
     422                 :             : 
     423                 :      265469 :   if (i == 0)
     424                 :      265469 :     return match_add_operand (result);
     425                 :             : 
     426                 :           0 :   if (gfc_notification_std (GFC_STD_GNU) == ERROR)
     427                 :             :     {
     428                 :           0 :       gfc_error ("Extension: Unary operator following "
     429                 :             :                  "arithmetic operator (use parentheses) at %C");
     430                 :           0 :       return MATCH_ERROR;
     431                 :             :     }
     432                 :             :   else
     433                 :           0 :     gfc_warning (0, "Extension: Unary operator following "
     434                 :             :                 "arithmetic operator (use parentheses) at %C");
     435                 :             : 
     436                 :           0 :   m = match_ext_add_operand (&e);
     437                 :           0 :   if (m != MATCH_YES)
     438                 :             :     return m;
     439                 :             : 
     440                 :           0 :   if (i == -1)
     441                 :           0 :     all = gfc_uminus (e);
     442                 :             :   else
     443                 :           0 :     all = gfc_uplus (e);
     444                 :             : 
     445                 :           0 :   if (all == NULL)
     446                 :             :     {
     447                 :           0 :       gfc_free_expr (e);
     448                 :           0 :       return MATCH_ERROR;
     449                 :             :     }
     450                 :             : 
     451                 :           0 :   all->where = where;
     452                 :           0 :   *result = all;
     453                 :           0 :   return MATCH_YES;
     454                 :             : }
     455                 :             : 
     456                 :             : 
     457                 :             : /* Match a level 2 expression.  */
     458                 :             : 
     459                 :             : static match
     460                 :     5498154 : match_level_2 (gfc_expr **result)
     461                 :             : {
     462                 :     5498154 :   gfc_expr *all, *e, *total;
     463                 :     5498154 :   locus where;
     464                 :     5498154 :   match m;
     465                 :     5498154 :   int i;
     466                 :             : 
     467                 :     5498154 :   where = gfc_current_locus;
     468                 :     5498154 :   i = match_add_op ();
     469                 :             : 
     470                 :     5498154 :   if (i != 0)
     471                 :             :     {
     472                 :      133718 :       m = match_ext_add_operand (&e);
     473                 :      133718 :       if (m == MATCH_NO)
     474                 :             :         {
     475                 :           8 :           gfc_error (expression_syntax);
     476                 :           8 :           m = MATCH_ERROR;
     477                 :             :         }
     478                 :             :     }
     479                 :             :   else
     480                 :     5364436 :     m = match_add_operand (&e);
     481                 :             : 
     482                 :     5498154 :   if (m != MATCH_YES)
     483                 :      632034 :     return m;
     484                 :             : 
     485                 :     4866120 :   if (i == 0)
     486                 :     4732416 :     all = e;
     487                 :             :   else
     488                 :             :     {
     489                 :      133704 :       if (i == -1)
     490                 :      133334 :         all = gfc_uminus (e);
     491                 :             :       else
     492                 :         370 :         all = gfc_uplus (e);
     493                 :             : 
     494                 :      133704 :       if (all == NULL)
     495                 :             :         {
     496                 :           0 :           gfc_free_expr (e);
     497                 :           0 :           return MATCH_ERROR;
     498                 :             :         }
     499                 :             :     }
     500                 :             : 
     501                 :     4866120 :   all->where = where;
     502                 :             : 
     503                 :             :   /* Append add-operands to the sum.  */
     504                 :             : 
     505                 :     5129616 :   for (;;)
     506                 :             :     {
     507                 :     4997868 :       where = gfc_current_locus;
     508                 :     4997868 :       i = match_add_op ();
     509                 :     4997868 :       if (i == 0)
     510                 :             :         break;
     511                 :             : 
     512                 :      131751 :       m = match_ext_add_operand (&e);
     513                 :      131751 :       if (m == MATCH_NO)
     514                 :           0 :         gfc_error (expression_syntax);
     515                 :      131751 :       if (m != MATCH_YES)
     516                 :             :         {
     517                 :           3 :           gfc_free_expr (all);
     518                 :           3 :           return MATCH_ERROR;
     519                 :             :         }
     520                 :             : 
     521                 :      131748 :       if (i == -1)
     522                 :       67237 :         total = gfc_subtract (all, e);
     523                 :             :       else
     524                 :       64511 :         total = gfc_add (all, e);
     525                 :             : 
     526                 :      131748 :       if (total == NULL)
     527                 :             :         {
     528                 :           0 :           gfc_free_expr (all);
     529                 :           0 :           gfc_free_expr (e);
     530                 :           0 :           return MATCH_ERROR;
     531                 :             :         }
     532                 :             : 
     533                 :      131748 :       all = total;
     534                 :      131748 :       all->where = where;
     535                 :             :     }
     536                 :             : 
     537                 :     4866117 :   *result = all;
     538                 :     4866117 :   return MATCH_YES;
     539                 :             : }
     540                 :             : 
     541                 :             : 
     542                 :             : /* Match a level three expression.  */
     543                 :             : 
     544                 :             : static match
     545                 :     5493181 : match_level_3 (gfc_expr **result)
     546                 :             : {
     547                 :     5493181 :   gfc_expr *all, *e, *total = NULL;
     548                 :     5493181 :   locus where;
     549                 :     5493181 :   match m;
     550                 :             : 
     551                 :     5493181 :   m = match_level_2 (&all);
     552                 :     5493181 :   if (m != MATCH_YES)
     553                 :             :     return m;
     554                 :             : 
     555                 :     4871082 :   for (;;)
     556                 :             :     {
     557                 :     4866116 :       if (!next_operator (INTRINSIC_CONCAT))
     558                 :             :         break;
     559                 :             : 
     560                 :        4973 :       where = gfc_current_locus;
     561                 :             : 
     562                 :        4973 :       m = match_level_2 (&e);
     563                 :        4973 :       if (m == MATCH_NO)
     564                 :           0 :         gfc_error (expression_syntax);
     565                 :        4973 :       if (m != MATCH_YES)
     566                 :             :         {
     567                 :           6 :           gfc_free_expr (all);
     568                 :           6 :           return MATCH_ERROR;
     569                 :             :         }
     570                 :             : 
     571                 :        4967 :       total = gfc_concat (all, e);
     572                 :        4967 :       if (total == NULL)
     573                 :             :         {
     574                 :           1 :           gfc_free_expr (all);
     575                 :           1 :           gfc_free_expr (e);
     576                 :           1 :           return MATCH_ERROR;
     577                 :             :         }
     578                 :             : 
     579                 :        4966 :       all = total;
     580                 :        4966 :       all->where = where;
     581                 :             :     }
     582                 :             : 
     583                 :     4861143 :   *result = all;
     584                 :     4861143 :   return MATCH_YES;
     585                 :             : }
     586                 :             : 
     587                 :             : 
     588                 :             : /* Match a level 4 expression.  */
     589                 :             : 
     590                 :             : static match
     591                 :     4807626 : match_level_4 (gfc_expr **result)
     592                 :             : {
     593                 :     4807626 :   gfc_expr *left, *right, *r;
     594                 :     4807626 :   gfc_intrinsic_op i;
     595                 :     4807626 :   locus old_loc;
     596                 :     4807626 :   locus where;
     597                 :     4807626 :   match m;
     598                 :             : 
     599                 :     4807626 :   m = match_level_3 (&left);
     600                 :     4807626 :   if (m != MATCH_YES)
     601                 :             :     return m;
     602                 :             : 
     603                 :     4175588 :   old_loc = gfc_current_locus;
     604                 :             : 
     605                 :     4175588 :   if (gfc_match_intrinsic_op (&i) != MATCH_YES)
     606                 :             :     {
     607                 :     3386933 :       *result = left;
     608                 :     3386933 :       return MATCH_YES;
     609                 :             :     }
     610                 :             : 
     611                 :      788655 :   if (i != INTRINSIC_EQ && i != INTRINSIC_NE && i != INTRINSIC_GE
     612                 :      370353 :       && i != INTRINSIC_LE && i != INTRINSIC_LT && i != INTRINSIC_GT
     613                 :      327685 :       && i != INTRINSIC_EQ_OS && i != INTRINSIC_NE_OS && i != INTRINSIC_GE_OS
     614                 :      118715 :       && i != INTRINSIC_LE_OS && i != INTRINSIC_LT_OS && i != INTRINSIC_GT_OS)
     615                 :             :     {
     616                 :      103100 :       gfc_current_locus = old_loc;
     617                 :      103100 :       *result = left;
     618                 :      103100 :       return MATCH_YES;
     619                 :             :     }
     620                 :             : 
     621                 :      685555 :   where = gfc_current_locus;
     622                 :             : 
     623                 :      685555 :   m = match_level_3 (&right);
     624                 :      685555 :   if (m == MATCH_NO)
     625                 :           0 :     gfc_error (expression_syntax);
     626                 :      685555 :   if (m != MATCH_YES)
     627                 :             :     {
     628                 :           0 :       gfc_free_expr (left);
     629                 :           0 :       return MATCH_ERROR;
     630                 :             :     }
     631                 :             : 
     632                 :      685555 :   switch (i)
     633                 :             :     {
     634                 :       32221 :     case INTRINSIC_EQ:
     635                 :       32221 :     case INTRINSIC_EQ_OS:
     636                 :       32221 :       r = gfc_eq (left, right, i);
     637                 :       32221 :       break;
     638                 :             : 
     639                 :      590263 :     case INTRINSIC_NE:
     640                 :      590263 :     case INTRINSIC_NE_OS:
     641                 :      590263 :       r = gfc_ne (left, right, i);
     642                 :      590263 :       break;
     643                 :             : 
     644                 :       10769 :     case INTRINSIC_LT:
     645                 :       10769 :     case INTRINSIC_LT_OS:
     646                 :       10769 :       r = gfc_lt (left, right, i);
     647                 :       10769 :       break;
     648                 :             : 
     649                 :        7195 :     case INTRINSIC_LE:
     650                 :        7195 :     case INTRINSIC_LE_OS:
     651                 :        7195 :       r = gfc_le (left, right, i);
     652                 :        7195 :       break;
     653                 :             : 
     654                 :       40319 :     case INTRINSIC_GT:
     655                 :       40319 :     case INTRINSIC_GT_OS:
     656                 :       40319 :       r = gfc_gt (left, right, i);
     657                 :       40319 :       break;
     658                 :             : 
     659                 :        4788 :     case INTRINSIC_GE:
     660                 :        4788 :     case INTRINSIC_GE_OS:
     661                 :        4788 :       r = gfc_ge (left, right, i);
     662                 :        4788 :       break;
     663                 :             : 
     664                 :           0 :     default:
     665                 :           0 :       gfc_internal_error ("match_level_4(): Bad operator");
     666                 :             :     }
     667                 :             : 
     668                 :      685555 :   if (r == NULL)
     669                 :             :     {
     670                 :           0 :       gfc_free_expr (left);
     671                 :           0 :       gfc_free_expr (right);
     672                 :           0 :       return MATCH_ERROR;
     673                 :             :     }
     674                 :             : 
     675                 :      685555 :   r->where = where;
     676                 :      685555 :   *result = r;
     677                 :             : 
     678                 :      685555 :   return MATCH_YES;
     679                 :             : }
     680                 :             : 
     681                 :             : 
     682                 :             : static match
     683                 :     4807626 : match_and_operand (gfc_expr **result)
     684                 :             : {
     685                 :     4807626 :   gfc_expr *e, *r;
     686                 :     4807626 :   locus where;
     687                 :     4807626 :   match m;
     688                 :     4807626 :   int i;
     689                 :             : 
     690                 :     4807626 :   i = next_operator (INTRINSIC_NOT);
     691                 :     4807626 :   where = gfc_current_locus;
     692                 :             : 
     693                 :     4807626 :   m = match_level_4 (&e);
     694                 :     4807626 :   if (m != MATCH_YES)
     695                 :             :     return m;
     696                 :             : 
     697                 :     4175588 :   r = e;
     698                 :     4175588 :   if (i)
     699                 :             :     {
     700                 :       72236 :       r = gfc_not (e);
     701                 :       72236 :       if (r == NULL)
     702                 :             :         {
     703                 :           0 :           gfc_free_expr (e);
     704                 :           0 :           return MATCH_ERROR;
     705                 :             :         }
     706                 :             :     }
     707                 :             : 
     708                 :     4175588 :   r->where = where;
     709                 :     4175588 :   *result = r;
     710                 :             : 
     711                 :     4175588 :   return MATCH_YES;
     712                 :             : }
     713                 :             : 
     714                 :             : 
     715                 :             : static match
     716                 :     4791141 : match_or_operand (gfc_expr **result)
     717                 :             : {
     718                 :     4791141 :   gfc_expr *all, *e, *total;
     719                 :     4791141 :   locus where;
     720                 :     4791141 :   match m;
     721                 :             : 
     722                 :     4791141 :   m = match_and_operand (&all);
     723                 :     4791141 :   if (m != MATCH_YES)
     724                 :             :     return m;
     725                 :             : 
     726                 :     4192073 :   for (;;)
     727                 :             :     {
     728                 :     4175588 :       if (!next_operator (INTRINSIC_AND))
     729                 :             :         break;
     730                 :       16485 :       where = gfc_current_locus;
     731                 :             : 
     732                 :       16485 :       m = match_and_operand (&e);
     733                 :       16485 :       if (m == MATCH_NO)
     734                 :           0 :         gfc_error (expression_syntax);
     735                 :       16485 :       if (m != MATCH_YES)
     736                 :             :         {
     737                 :           0 :           gfc_free_expr (all);
     738                 :           0 :           return MATCH_ERROR;
     739                 :             :         }
     740                 :             : 
     741                 :       16485 :       total = gfc_and (all, e);
     742                 :       16485 :       if (total == NULL)
     743                 :             :         {
     744                 :           0 :           gfc_free_expr (all);
     745                 :           0 :           gfc_free_expr (e);
     746                 :           0 :           return MATCH_ERROR;
     747                 :             :         }
     748                 :             : 
     749                 :       16485 :       all = total;
     750                 :       16485 :       all->where = where;
     751                 :             :     }
     752                 :             : 
     753                 :     4159103 :   *result = all;
     754                 :     4159103 :   return MATCH_YES;
     755                 :             : }
     756                 :             : 
     757                 :             : 
     758                 :             : static match
     759                 :     4716535 : match_equiv_operand (gfc_expr **result)
     760                 :             : {
     761                 :     4716535 :   gfc_expr *all, *e, *total;
     762                 :     4716535 :   locus where;
     763                 :     4716535 :   match m;
     764                 :             : 
     765                 :     4716535 :   m = match_or_operand (&all);
     766                 :     4716535 :   if (m != MATCH_YES)
     767                 :             :     return m;
     768                 :             : 
     769                 :     4233709 :   for (;;)
     770                 :             :     {
     771                 :     4159103 :       if (!next_operator (INTRINSIC_OR))
     772                 :             :         break;
     773                 :       74606 :       where = gfc_current_locus;
     774                 :             : 
     775                 :       74606 :       m = match_or_operand (&e);
     776                 :       74606 :       if (m == MATCH_NO)
     777                 :           0 :         gfc_error (expression_syntax);
     778                 :       74606 :       if (m != MATCH_YES)
     779                 :             :         {
     780                 :           0 :           gfc_free_expr (all);
     781                 :           0 :           return MATCH_ERROR;
     782                 :             :         }
     783                 :             : 
     784                 :       74606 :       total = gfc_or (all, e);
     785                 :       74606 :       if (total == NULL)
     786                 :             :         {
     787                 :           0 :           gfc_free_expr (all);
     788                 :           0 :           gfc_free_expr (e);
     789                 :           0 :           return MATCH_ERROR;
     790                 :             :         }
     791                 :             : 
     792                 :       74606 :       all = total;
     793                 :       74606 :       all->where = where;
     794                 :             :     }
     795                 :             : 
     796                 :     4084497 :   *result = all;
     797                 :     4084497 :   return MATCH_YES;
     798                 :             : }
     799                 :             : 
     800                 :             : 
     801                 :             : /* Match a level 5 expression.  */
     802                 :             : 
     803                 :             : static match
     804                 :     4694330 : match_level_5 (gfc_expr **result)
     805                 :             : {
     806                 :     4694330 :   gfc_expr *all, *e, *total;
     807                 :     4694330 :   locus where;
     808                 :     4694330 :   match m;
     809                 :     4694330 :   gfc_intrinsic_op i;
     810                 :             : 
     811                 :     4694330 :   m = match_equiv_operand (&all);
     812                 :     4694330 :   if (m != MATCH_YES)
     813                 :             :     return m;
     814                 :             : 
     815                 :     4106702 :   for (;;)
     816                 :             :     {
     817                 :     4084497 :       if (next_operator (INTRINSIC_EQV))
     818                 :             :         i = INTRINSIC_EQV;
     819                 :             :       else
     820                 :             :         {
     821                 :     4082551 :           if (next_operator (INTRINSIC_NEQV))
     822                 :             :             i = INTRINSIC_NEQV;
     823                 :             :           else
     824                 :             :             break;
     825                 :             :         }
     826                 :             : 
     827                 :       22205 :       where = gfc_current_locus;
     828                 :             : 
     829                 :       22205 :       m = match_equiv_operand (&e);
     830                 :       22205 :       if (m == MATCH_NO)
     831                 :           0 :         gfc_error (expression_syntax);
     832                 :       22205 :       if (m != MATCH_YES)
     833                 :             :         {
     834                 :           0 :           gfc_free_expr (all);
     835                 :           0 :           return MATCH_ERROR;
     836                 :             :         }
     837                 :             : 
     838                 :       22205 :       if (i == INTRINSIC_EQV)
     839                 :        1946 :         total = gfc_eqv (all, e);
     840                 :             :       else
     841                 :       20259 :         total = gfc_neqv (all, e);
     842                 :             : 
     843                 :       22205 :       if (total == NULL)
     844                 :             :         {
     845                 :           0 :           gfc_free_expr (all);
     846                 :           0 :           gfc_free_expr (e);
     847                 :           0 :           return MATCH_ERROR;
     848                 :             :         }
     849                 :             : 
     850                 :       22205 :       all = total;
     851                 :       22205 :       all->where = where;
     852                 :             :     }
     853                 :             : 
     854                 :     4062292 :   *result = all;
     855                 :     4062292 :   return MATCH_YES;
     856                 :             : }
     857                 :             : 
     858                 :             : 
     859                 :             : /* Match an expression.  At this level, we are stringing together
     860                 :             :    level 5 expressions separated by binary operators.  */
     861                 :             : 
     862                 :             : match
     863                 :     4694151 : gfc_match_expr (gfc_expr **result)
     864                 :             : {
     865                 :     4694151 :   gfc_expr *all, *e;
     866                 :     4694151 :   gfc_user_op *uop;
     867                 :     4694151 :   locus where;
     868                 :     4694151 :   match m;
     869                 :             : 
     870                 :     4694151 :   m = match_level_5 (&all);
     871                 :     4694151 :   if (m != MATCH_YES)
     872                 :             :     return m;
     873                 :             : 
     874                 :     4062471 :   for (;;)
     875                 :             :     {
     876                 :     4062292 :       uop = NULL;
     877                 :     4062292 :       m = match_defined_operator (&uop);
     878                 :     4062292 :       if (m == MATCH_NO)
     879                 :             :         break;
     880                 :         215 :       if (m == MATCH_ERROR)
     881                 :             :         {
     882                 :          36 :           gfc_free_expr (all);
     883                 :          36 :           return MATCH_ERROR;
     884                 :             :         }
     885                 :             : 
     886                 :         179 :       where = gfc_current_locus;
     887                 :             : 
     888                 :         179 :       m = match_level_5 (&e);
     889                 :         179 :       if (m == MATCH_NO)
     890                 :           0 :         gfc_error (expression_syntax);
     891                 :         179 :       if (m != MATCH_YES)
     892                 :             :         {
     893                 :           0 :           gfc_free_expr (all);
     894                 :           0 :           return MATCH_ERROR;
     895                 :             :         }
     896                 :             : 
     897                 :         179 :       all = gfc_get_operator_expr (&where, INTRINSIC_USER, all, e);
     898                 :         179 :       all->value.op.uop = uop;
     899                 :             :     }
     900                 :             : 
     901                 :     4062077 :   *result = all;
     902                 :     4062077 :   return MATCH_YES;
     903                 :             : }
        

Generated by: LCOV version 2.0-1

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