LCOV - code coverage report
Current view: top level - gcc/fortran - matchexp.c (source / functions) Hit Total Coverage
Test: gcc.info Lines: 376 442 85.1 %
Date: 2020-03-28 11:57:23 Functions: 19 19 100.0 %
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-2020 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                 :    7400080 : gfc_match_defined_op_name (char *result, int error_flag)
      37                 :            : {
      38                 :    7400080 :   static const char * const badops[] = {
      39                 :            :     "and", "or", "not", "eqv", "neqv", "eq", "ne", "ge", "le", "lt", "gt",
      40                 :            :       NULL
      41                 :            :   };
      42                 :            : 
      43                 :    7400080 :   char name[GFC_MAX_SYMBOL_LEN + 1];
      44                 :    7400080 :   locus old_loc;
      45                 :    7400080 :   match m;
      46                 :    7400080 :   int i;
      47                 :            : 
      48                 :    7400080 :   old_loc = gfc_current_locus;
      49                 :            : 
      50                 :    7400080 :   m = gfc_match (" . %n .", name);
      51                 :    7400080 :   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                 :      32339 :   if (strcmp (name, "true") == 0 || strcmp (name, "false") == 0)
      58                 :            :     {
      59                 :      31579 :       if (error_flag)
      60                 :          0 :         goto error;
      61                 :      31579 :       gfc_current_locus = old_loc;
      62                 :      31579 :       return MATCH_NO;
      63                 :            :     }
      64                 :            : 
      65                 :       9119 :   for (i = 0; badops[i]; i++)
      66                 :       8360 :     if (strcmp (badops[i], name) == 0)
      67                 :          1 :       goto error;
      68                 :            : 
      69                 :       3498 :   for (i = 0; name[i]; i++)
      70                 :       2775 :     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                 :        723 :   strcpy (result, name);
      77                 :        723 :   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                 :    7398700 : match_defined_operator (gfc_user_op **result)
      93                 :            : {
      94                 :    7398700 :   char name[GFC_MAX_SYMBOL_LEN + 1];
      95                 :    7398700 :   match m;
      96                 :            : 
      97                 :    7398700 :   m = gfc_match_defined_op_name (name, 0);
      98                 :    7398700 :   if (m != MATCH_YES)
      99                 :            :     return m;
     100                 :            : 
     101                 :        365 :   *result = gfc_get_uop (name);
     102                 :        365 :   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                 :   47382200 : next_operator (gfc_intrinsic_op t)
     111                 :            : {
     112                 :   47382200 :   gfc_intrinsic_op u;
     113                 :   47382200 :   locus old_loc;
     114                 :            : 
     115                 :   47382200 :   old_loc = gfc_current_locus;
     116                 :   47382200 :   if (gfc_match_intrinsic_op (&u) == MATCH_YES && t == u)
     117                 :            :     return 1;
     118                 :            : 
     119                 :   46923400 :   gfc_current_locus = old_loc;
     120                 :   46923400 :   return 0;
     121                 :            : }
     122                 :            : 
     123                 :            : 
     124                 :            : /* Call the INTRINSIC_PARENTHESES function.  This is both
     125                 :            :    used explicitly, as below, or by resolve.c to generate
     126                 :            :    temporaries.  */
     127                 :            : 
     128                 :            : gfc_expr *
     129                 :      49810 : gfc_get_parentheses (gfc_expr *e)
     130                 :            : {
     131                 :      49810 :   gfc_expr *e2;
     132                 :            : 
     133                 :      49810 :   e2 = gfc_get_operator_expr (&e->where, INTRINSIC_PARENTHESES, e, NULL);
     134                 :      49810 :   e2->ts = e->ts;
     135                 :      49810 :   e2->rank = e->rank;
     136                 :            : 
     137                 :      49810 :   return e2;
     138                 :            : }
     139                 :            : 
     140                 :            : 
     141                 :            : /* Match a primary expression.  */
     142                 :            : 
     143                 :            : static match
     144                 :    4353680 : match_primary (gfc_expr **result)
     145                 :            : {
     146                 :    4353680 :   match m;
     147                 :    4353680 :   gfc_expr *e;
     148                 :            : 
     149                 :    4353680 :   m = gfc_match_literal_constant (result, 0);
     150                 :    4353680 :   if (m != MATCH_NO)
     151                 :            :     return m;
     152                 :            : 
     153                 :    2554200 :   m = gfc_match_array_constructor (result);
     154                 :    2554200 :   if (m != MATCH_NO)
     155                 :            :     return m;
     156                 :            : 
     157                 :    2477880 :   m = gfc_match_rvalue (result);
     158                 :    2477880 :   if (m != MATCH_NO)
     159                 :            :     return m;
     160                 :            : 
     161                 :            :   /* Match an expression in parentheses.  */
     162                 :     141598 :   if (gfc_match_char ('(') != MATCH_YES)
     163                 :            :     return MATCH_NO;
     164                 :            : 
     165                 :      49489 :   m = gfc_match_expr (&e);
     166                 :      49489 :   if (m == MATCH_NO)
     167                 :         64 :     goto syntax;
     168                 :      49425 :   if (m == MATCH_ERROR)
     169                 :            :     return m;
     170                 :            : 
     171                 :      49421 :   m = gfc_match_char (')');
     172                 :      49421 :   if (m == MATCH_NO)
     173                 :       2112 :     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                 :      49421 :   *result = gfc_get_parentheses (e);
     179                 :            : 
     180                 :      49421 :   if (m != MATCH_YES)
     181                 :            :     {
     182                 :       2112 :       gfc_free_expr (*result);
     183                 :       2112 :       return MATCH_ERROR;
     184                 :            :     }
     185                 :            : 
     186                 :            :   return MATCH_YES;
     187                 :            : 
     188                 :         64 : syntax:
     189                 :         64 :   gfc_error (expression_syntax);
     190                 :         64 :   return MATCH_ERROR;
     191                 :            : }
     192                 :            : 
     193                 :            : 
     194                 :            : /* Match a level 1 expression.  */
     195                 :            : 
     196                 :            : static match
     197                 :    4353680 : match_level_1 (gfc_expr **result)
     198                 :            : {
     199                 :    4353680 :   gfc_user_op *uop;
     200                 :    4353680 :   gfc_expr *e, *f;
     201                 :    4353680 :   locus where;
     202                 :    4353680 :   match m;
     203                 :            : 
     204                 :    4353680 :   gfc_gobble_whitespace ();
     205                 :    4353680 :   where = gfc_current_locus;
     206                 :    4353680 :   uop = NULL;
     207                 :    4353680 :   m = match_defined_operator (&uop);
     208                 :    4353680 :   if (m == MATCH_ERROR)
     209                 :            :     return m;
     210                 :            : 
     211                 :    4353680 :   m = match_primary (&e);
     212                 :    4353680 :   if (m != MATCH_YES)
     213                 :            :     return m;
     214                 :            : 
     215                 :    3832280 :   if (uop == NULL)
     216                 :    3832060 :     *result = e;
     217                 :            :   else
     218                 :            :     {
     219                 :        218 :       f = gfc_get_operator_expr (&where, INTRINSIC_USER, e, NULL);
     220                 :        218 :       f->value.op.uop = uop;
     221                 :        218 :       *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                 :    8216580 : match_add_op (void)
     249                 :            : {
     250                 :    8216580 :   if (next_operator (INTRINSIC_MINUS))
     251                 :            :     return -1;
     252                 :    8056600 :   if (next_operator (INTRINSIC_PLUS))
     253                 :      47587 :     return 1;
     254                 :            :   return 0;
     255                 :            : }
     256                 :            : 
     257                 :            : 
     258                 :            : static match
     259                 :    4353680 : match_mult_operand (gfc_expr **result)
     260                 :            : {
     261                 :            :   /* Workaround -Wmaybe-uninitialized false positive during
     262                 :            :      profiledbootstrap by initializing them.  */
     263                 :    4353680 :   gfc_expr *e = NULL, *exp, *r;
     264                 :    4353680 :   locus where;
     265                 :    4353680 :   match m;
     266                 :            : 
     267                 :    4353680 :   m = match_level_1 (&e);
     268                 :    4353680 :   if (m != MATCH_YES)
     269                 :            :     return m;
     270                 :            : 
     271                 :    3832280 :   if (!next_operator (INTRINSIC_POWER))
     272                 :            :     {
     273                 :    3825550 :       *result = e;
     274                 :    3825550 :       return MATCH_YES;
     275                 :            :     }
     276                 :            : 
     277                 :       6727 :   where = gfc_current_locus;
     278                 :            : 
     279                 :       6727 :   m = match_ext_mult_operand (&exp);
     280                 :       6727 :   if (m == MATCH_NO)
     281                 :          0 :     gfc_error ("Expected exponent in expression at %C");
     282                 :       6727 :   if (m != MATCH_YES)
     283                 :            :     {
     284                 :          0 :       gfc_free_expr (e);
     285                 :          0 :       return MATCH_ERROR;
     286                 :            :     }
     287                 :            : 
     288                 :       6727 :   r = gfc_power (e, exp);
     289                 :       6727 :   if (r == NULL)
     290                 :            :     {
     291                 :          0 :       gfc_free_expr (e);
     292                 :          0 :       gfc_free_expr (exp);
     293                 :          0 :       return MATCH_ERROR;
     294                 :            :     }
     295                 :            : 
     296                 :       6727 :   r->where = where;
     297                 :       6727 :   *result = r;
     298                 :            : 
     299                 :       6727 :   return MATCH_YES;
     300                 :            : }
     301                 :            : 
     302                 :            : 
     303                 :            : static match
     304                 :     107307 : match_ext_mult_operand (gfc_expr **result)
     305                 :            : {
     306                 :     107307 :   gfc_expr *all, *e;
     307                 :     107307 :   locus where;
     308                 :     107307 :   match m;
     309                 :     107307 :   int i;
     310                 :            : 
     311                 :     107307 :   where = gfc_current_locus;
     312                 :     107307 :   i = match_add_op ();
     313                 :            : 
     314                 :     107307 :   if (i == 0)
     315                 :     107294 :     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                 :    4246390 : match_add_operand (gfc_expr **result)
     350                 :            : {
     351                 :    4246390 :   gfc_expr *all, *e, *total;
     352                 :    4246390 :   locus where, old_loc;
     353                 :    4246390 :   match m;
     354                 :    4246390 :   gfc_intrinsic_op i;
     355                 :            : 
     356                 :    4246390 :   m = match_mult_operand (&all);
     357                 :    4246390 :   if (m != MATCH_YES)
     358                 :            :     return m;
     359                 :            : 
     360                 :    3889110 :   for (;;)
     361                 :            :     {
     362                 :            :       /* Build up a string of products or quotients.  */
     363                 :            : 
     364                 :    3825550 :       old_loc = gfc_current_locus;
     365                 :            : 
     366                 :    3825550 :       if (next_operator (INTRINSIC_TIMES))
     367                 :            :         i = INTRINSIC_TIMES;
     368                 :            :       else
     369                 :            :         {
     370                 :    3772490 :           if (next_operator (INTRINSIC_DIVIDE))
     371                 :            :             i = INTRINSIC_DIVIDE;
     372                 :            :           else
     373                 :            :             break;
     374                 :            :         }
     375                 :            : 
     376                 :     100567 :       where = gfc_current_locus;
     377                 :            : 
     378                 :     100567 :       m = match_ext_mult_operand (&e);
     379                 :     100567 :       if (m == MATCH_NO)
     380                 :            :         {
     381                 :      36996 :           gfc_current_locus = old_loc;
     382                 :      36996 :           break;
     383                 :            :         }
     384                 :            : 
     385                 :      63571 :       if (m == MATCH_ERROR)
     386                 :            :         {
     387                 :          0 :           gfc_free_expr (all);
     388                 :          0 :           return MATCH_ERROR;
     389                 :            :         }
     390                 :            : 
     391                 :      63571 :       if (i == INTRINSIC_TIMES)
     392                 :      53058 :         total = gfc_multiply (all, e);
     393                 :            :       else
     394                 :      10513 :         total = gfc_divide (all, e);
     395                 :            : 
     396                 :      63571 :       if (total == NULL)
     397                 :            :         {
     398                 :          5 :           gfc_free_expr (all);
     399                 :          5 :           gfc_free_expr (e);
     400                 :          5 :           return MATCH_ERROR;
     401                 :            :         }
     402                 :            : 
     403                 :      63566 :       all = total;
     404                 :      63566 :       all->where = where;
     405                 :            :     }
     406                 :            : 
     407                 :    3761980 :   *result = all;
     408                 :    3761980 :   return MATCH_YES;
     409                 :            : }
     410                 :            : 
     411                 :            : 
     412                 :            : static match
     413                 :     207554 : match_ext_add_operand (gfc_expr **result)
     414                 :            : {
     415                 :     207554 :   gfc_expr *all, *e;
     416                 :     207554 :   locus where;
     417                 :     207554 :   match m;
     418                 :     207554 :   int i;
     419                 :            : 
     420                 :     207554 :   where = gfc_current_locus;
     421                 :     207554 :   i = match_add_op ();
     422                 :            : 
     423                 :     207554 :   if (i == 0)
     424                 :     207554 :     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                 :    4139750 : match_level_2 (gfc_expr **result)
     461                 :            : {
     462                 :    4139750 :   gfc_expr *all, *e, *total;
     463                 :    4139750 :   locus where;
     464                 :    4139750 :   match m;
     465                 :    4139750 :   int i;
     466                 :            : 
     467                 :    4139750 :   where = gfc_current_locus;
     468                 :    4139750 :   i = match_add_op ();
     469                 :            : 
     470                 :    4139750 :   if (i != 0)
     471                 :            :     {
     472                 :     100911 :       m = match_ext_add_operand (&e);
     473                 :     100911 :       if (m == MATCH_NO)
     474                 :            :         {
     475                 :          8 :           gfc_error (expression_syntax);
     476                 :          8 :           m = MATCH_ERROR;
     477                 :            :         }
     478                 :            :     }
     479                 :            :   else
     480                 :    4038840 :     m = match_add_operand (&e);
     481                 :            : 
     482                 :    4139750 :   if (m != MATCH_YES)
     483                 :     484411 :     return m;
     484                 :            : 
     485                 :    3655340 :   if (i == 0)
     486                 :    3554440 :     all = e;
     487                 :            :   else
     488                 :            :     {
     489                 :     100899 :       if (i == -1)
     490                 :     100571 :         all = gfc_uminus (e);
     491                 :            :       else
     492                 :        328 :         all = gfc_uplus (e);
     493                 :            : 
     494                 :     100899 :       if (all == NULL)
     495                 :            :         {
     496                 :          0 :           gfc_free_expr (e);
     497                 :          0 :           return MATCH_ERROR;
     498                 :            :         }
     499                 :            :     }
     500                 :            : 
     501                 :    3655340 :   all->where = where;
     502                 :            : 
     503                 :            :   /* Append add-operands to the sum.  */
     504                 :            : 
     505                 :    3868620 :   for (;;)
     506                 :            :     {
     507                 :    3761980 :       where = gfc_current_locus;
     508                 :    3761980 :       i = match_add_op ();
     509                 :    3761980 :       if (i == 0)
     510                 :            :         break;
     511                 :            : 
     512                 :     106643 :       m = match_ext_add_operand (&e);
     513                 :     106643 :       if (m == MATCH_NO)
     514                 :          0 :         gfc_error (expression_syntax);
     515                 :     106643 :       if (m != MATCH_YES)
     516                 :            :         {
     517                 :          3 :           gfc_free_expr (all);
     518                 :          3 :           return MATCH_ERROR;
     519                 :            :         }
     520                 :            : 
     521                 :     106640 :       if (i == -1)
     522                 :      59390 :         total = gfc_subtract (all, e);
     523                 :            :       else
     524                 :      47250 :         total = gfc_add (all, e);
     525                 :            : 
     526                 :     106640 :       if (total == NULL)
     527                 :            :         {
     528                 :          0 :           gfc_free_expr (all);
     529                 :          0 :           gfc_free_expr (e);
     530                 :          0 :           return MATCH_ERROR;
     531                 :            :         }
     532                 :            : 
     533                 :     106640 :       all = total;
     534                 :     106640 :       all->where = where;
     535                 :            :     }
     536                 :            : 
     537                 :    3655330 :   *result = all;
     538                 :    3655330 :   return MATCH_YES;
     539                 :            : }
     540                 :            : 
     541                 :            : 
     542                 :            : /* Match a level three expression.  */
     543                 :            : 
     544                 :            : static match
     545                 :    4135450 : match_level_3 (gfc_expr **result)
     546                 :            : {
     547                 :    4135450 :   gfc_expr *all, *e, *total = NULL;
     548                 :    4135450 :   locus where;
     549                 :    4135450 :   match m;
     550                 :            : 
     551                 :    4135450 :   m = match_level_2 (&all);
     552                 :    4135450 :   if (m != MATCH_YES)
     553                 :            :     return m;
     554                 :            : 
     555                 :    3659620 :   for (;;)
     556                 :            :     {
     557                 :    3655330 :       if (!next_operator (INTRINSIC_CONCAT))
     558                 :            :         break;
     559                 :            : 
     560                 :       4295 :       where = gfc_current_locus;
     561                 :            : 
     562                 :       4295 :       m = match_level_2 (&e);
     563                 :       4295 :       if (m == MATCH_NO)
     564                 :          0 :         gfc_error (expression_syntax);
     565                 :       4295 :       if (m != MATCH_YES)
     566                 :            :         {
     567                 :          6 :           gfc_free_expr (all);
     568                 :          6 :           return MATCH_ERROR;
     569                 :            :         }
     570                 :            : 
     571                 :       4289 :       total = gfc_concat (all, e);
     572                 :       4289 :       if (total == NULL)
     573                 :            :         {
     574                 :          1 :           gfc_free_expr (all);
     575                 :          1 :           gfc_free_expr (e);
     576                 :          1 :           return MATCH_ERROR;
     577                 :            :         }
     578                 :            : 
     579                 :       4288 :       all = total;
     580                 :       4288 :       all->where = where;
     581                 :            :     }
     582                 :            : 
     583                 :    3651040 :   *result = all;
     584                 :    3651040 :   return MATCH_YES;
     585                 :            : }
     586                 :            : 
     587                 :            : 
     588                 :            : /* Match a level 4 expression.  */
     589                 :            : 
     590                 :            : static match
     591                 :    3627440 : match_level_4 (gfc_expr **result)
     592                 :            : {
     593                 :    3627440 :   gfc_expr *left, *right, *r;
     594                 :    3627440 :   gfc_intrinsic_op i;
     595                 :    3627440 :   locus old_loc;
     596                 :    3627440 :   locus where;
     597                 :    3627440 :   match m;
     598                 :            : 
     599                 :    3627440 :   m = match_level_3 (&left);
     600                 :    3627440 :   if (m != MATCH_YES)
     601                 :            :     return m;
     602                 :            : 
     603                 :    3143030 :   old_loc = gfc_current_locus;
     604                 :            : 
     605                 :    3143030 :   if (gfc_match_intrinsic_op (&i) != MATCH_YES)
     606                 :            :     {
     607                 :    2545060 :       *result = left;
     608                 :    2545060 :       return MATCH_YES;
     609                 :            :     }
     610                 :            : 
     611                 :     597969 :   if (i != INTRINSIC_EQ && i != INTRINSIC_NE && i != INTRINSIC_GE
     612                 :     324384 :       && i != INTRINSIC_LE && i != INTRINSIC_LT && i != INTRINSIC_GT
     613                 :     291195 :       && i != INTRINSIC_EQ_OS && i != INTRINSIC_NE_OS && i != INTRINSIC_GE_OS
     614                 :     105174 :       && i != INTRINSIC_LE_OS && i != INTRINSIC_LT_OS && i != INTRINSIC_GT_OS)
     615                 :            :     {
     616                 :      89963 :       gfc_current_locus = old_loc;
     617                 :      89963 :       *result = left;
     618                 :      89963 :       return MATCH_YES;
     619                 :            :     }
     620                 :            : 
     621                 :     508006 :   where = gfc_current_locus;
     622                 :            : 
     623                 :     508006 :   m = match_level_3 (&right);
     624                 :     508006 :   if (m == MATCH_NO)
     625                 :          0 :     gfc_error (expression_syntax);
     626                 :     508006 :   if (m != MATCH_YES)
     627                 :            :     {
     628                 :          0 :       gfc_free_expr (left);
     629                 :          0 :       return MATCH_ERROR;
     630                 :            :     }
     631                 :            : 
     632                 :     508006 :   switch (i)
     633                 :            :     {
     634                 :      22097 :     case INTRINSIC_EQ:
     635                 :      22097 :     case INTRINSIC_EQ_OS:
     636                 :      22097 :       r = gfc_eq (left, right, i);
     637                 :      22097 :       break;
     638                 :            : 
     639                 :     433124 :     case INTRINSIC_NE:
     640                 :     433124 :     case INTRINSIC_NE_OS:
     641                 :     433124 :       r = gfc_ne (left, right, i);
     642                 :     433124 :       break;
     643                 :            : 
     644                 :       8233 :     case INTRINSIC_LT:
     645                 :       8233 :     case INTRINSIC_LT_OS:
     646                 :       8233 :       r = gfc_lt (left, right, i);
     647                 :       8233 :       break;
     648                 :            : 
     649                 :       5075 :     case INTRINSIC_LE:
     650                 :       5075 :     case INTRINSIC_LE_OS:
     651                 :       5075 :       r = gfc_le (left, right, i);
     652                 :       5075 :       break;
     653                 :            : 
     654                 :      35092 :     case INTRINSIC_GT:
     655                 :      35092 :     case INTRINSIC_GT_OS:
     656                 :      35092 :       r = gfc_gt (left, right, i);
     657                 :      35092 :       break;
     658                 :            : 
     659                 :       4385 :     case INTRINSIC_GE:
     660                 :       4385 :     case INTRINSIC_GE_OS:
     661                 :       4385 :       r = gfc_ge (left, right, i);
     662                 :       4385 :       break;
     663                 :            : 
     664                 :          0 :     default:
     665                 :          0 :       gfc_internal_error ("match_level_4(): Bad operator");
     666                 :            :     }
     667                 :            : 
     668                 :     508006 :   if (r == NULL)
     669                 :            :     {
     670                 :          0 :       gfc_free_expr (left);
     671                 :          0 :       gfc_free_expr (right);
     672                 :          0 :       return MATCH_ERROR;
     673                 :            :     }
     674                 :            : 
     675                 :     508006 :   r->where = where;
     676                 :     508006 :   *result = r;
     677                 :            : 
     678                 :     508006 :   return MATCH_YES;
     679                 :            : }
     680                 :            : 
     681                 :            : 
     682                 :            : static match
     683                 :    3627440 : match_and_operand (gfc_expr **result)
     684                 :            : {
     685                 :    3627440 :   gfc_expr *e, *r;
     686                 :    3627440 :   locus where;
     687                 :    3627440 :   match m;
     688                 :    3627440 :   int i;
     689                 :            : 
     690                 :    3627440 :   i = next_operator (INTRINSIC_NOT);
     691                 :    3627440 :   where = gfc_current_locus;
     692                 :            : 
     693                 :    3627440 :   m = match_level_4 (&e);
     694                 :    3627440 :   if (m != MATCH_YES)
     695                 :            :     return m;
     696                 :            : 
     697                 :    3143030 :   r = e;
     698                 :    3143030 :   if (i)
     699                 :            :     {
     700                 :      41590 :       r = gfc_not (e);
     701                 :      41590 :       if (r == NULL)
     702                 :            :         {
     703                 :          0 :           gfc_free_expr (e);
     704                 :          0 :           return MATCH_ERROR;
     705                 :            :         }
     706                 :            :     }
     707                 :            : 
     708                 :    3143030 :   r->where = where;
     709                 :    3143030 :   *result = r;
     710                 :            : 
     711                 :    3143030 :   return MATCH_YES;
     712                 :            : }
     713                 :            : 
     714                 :            : 
     715                 :            : static match
     716                 :    3612020 : match_or_operand (gfc_expr **result)
     717                 :            : {
     718                 :    3612020 :   gfc_expr *all, *e, *total;
     719                 :    3612020 :   locus where;
     720                 :    3612020 :   match m;
     721                 :            : 
     722                 :    3612020 :   m = match_and_operand (&all);
     723                 :    3612020 :   if (m != MATCH_YES)
     724                 :            :     return m;
     725                 :            : 
     726                 :    3158450 :   for (;;)
     727                 :            :     {
     728                 :    3143030 :       if (!next_operator (INTRINSIC_AND))
     729                 :            :         break;
     730                 :      15422 :       where = gfc_current_locus;
     731                 :            : 
     732                 :      15422 :       m = match_and_operand (&e);
     733                 :      15422 :       if (m == MATCH_NO)
     734                 :          0 :         gfc_error (expression_syntax);
     735                 :      15422 :       if (m != MATCH_YES)
     736                 :            :         {
     737                 :          0 :           gfc_free_expr (all);
     738                 :          0 :           return MATCH_ERROR;
     739                 :            :         }
     740                 :            : 
     741                 :      15422 :       total = gfc_and (all, e);
     742                 :      15422 :       if (total == NULL)
     743                 :            :         {
     744                 :          0 :           gfc_free_expr (all);
     745                 :          0 :           gfc_free_expr (e);
     746                 :          0 :           return MATCH_ERROR;
     747                 :            :         }
     748                 :            : 
     749                 :      15422 :       all = total;
     750                 :      15422 :       all->where = where;
     751                 :            :     }
     752                 :            : 
     753                 :    3127610 :   *result = all;
     754                 :    3127610 :   return MATCH_YES;
     755                 :            : }
     756                 :            : 
     757                 :            : 
     758                 :            : static match
     759                 :    3547860 : match_equiv_operand (gfc_expr **result)
     760                 :            : {
     761                 :    3547860 :   gfc_expr *all, *e, *total;
     762                 :    3547860 :   locus where;
     763                 :    3547860 :   match m;
     764                 :            : 
     765                 :    3547860 :   m = match_or_operand (&all);
     766                 :    3547860 :   if (m != MATCH_YES)
     767                 :            :     return m;
     768                 :            : 
     769                 :    3191770 :   for (;;)
     770                 :            :     {
     771                 :    3127610 :       if (!next_operator (INTRINSIC_OR))
     772                 :            :         break;
     773                 :      64159 :       where = gfc_current_locus;
     774                 :            : 
     775                 :      64159 :       m = match_or_operand (&e);
     776                 :      64159 :       if (m == MATCH_NO)
     777                 :          0 :         gfc_error (expression_syntax);
     778                 :      64159 :       if (m != MATCH_YES)
     779                 :            :         {
     780                 :          0 :           gfc_free_expr (all);
     781                 :          0 :           return MATCH_ERROR;
     782                 :            :         }
     783                 :            : 
     784                 :      64159 :       total = gfc_or (all, e);
     785                 :      64159 :       if (total == NULL)
     786                 :            :         {
     787                 :          0 :           gfc_free_expr (all);
     788                 :          0 :           gfc_free_expr (e);
     789                 :          0 :           return MATCH_ERROR;
     790                 :            :         }
     791                 :            : 
     792                 :      64159 :       all = total;
     793                 :      64159 :       all->where = where;
     794                 :            :     }
     795                 :            : 
     796                 :    3063450 :   *result = all;
     797                 :    3063450 :   return MATCH_YES;
     798                 :            : }
     799                 :            : 
     800                 :            : 
     801                 :            : /* Match a level 5 expression.  */
     802                 :            : 
     803                 :            : static match
     804                 :    3529430 : match_level_5 (gfc_expr **result)
     805                 :            : {
     806                 :    3529430 :   gfc_expr *all, *e, *total;
     807                 :    3529430 :   locus where;
     808                 :    3529430 :   match m;
     809                 :    3529430 :   gfc_intrinsic_op i;
     810                 :            : 
     811                 :    3529430 :   m = match_equiv_operand (&all);
     812                 :    3529430 :   if (m != MATCH_YES)
     813                 :            :     return m;
     814                 :            : 
     815                 :    3081880 :   for (;;)
     816                 :            :     {
     817                 :    3063450 :       if (next_operator (INTRINSIC_EQV))
     818                 :            :         i = INTRINSIC_EQV;
     819                 :            :       else
     820                 :            :         {
     821                 :    3061820 :           if (next_operator (INTRINSIC_NEQV))
     822                 :            :             i = INTRINSIC_NEQV;
     823                 :            :           else
     824                 :            :             break;
     825                 :            :         }
     826                 :            : 
     827                 :      18434 :       where = gfc_current_locus;
     828                 :            : 
     829                 :      18434 :       m = match_equiv_operand (&e);
     830                 :      18434 :       if (m == MATCH_NO)
     831                 :          0 :         gfc_error (expression_syntax);
     832                 :      18434 :       if (m != MATCH_YES)
     833                 :            :         {
     834                 :          0 :           gfc_free_expr (all);
     835                 :          0 :           return MATCH_ERROR;
     836                 :            :         }
     837                 :            : 
     838                 :      18434 :       if (i == INTRINSIC_EQV)
     839                 :       1633 :         total = gfc_eqv (all, e);
     840                 :            :       else
     841                 :      16801 :         total = gfc_neqv (all, e);
     842                 :            : 
     843                 :      18434 :       if (total == NULL)
     844                 :            :         {
     845                 :          0 :           gfc_free_expr (all);
     846                 :          0 :           gfc_free_expr (e);
     847                 :          0 :           return MATCH_ERROR;
     848                 :            :         }
     849                 :            : 
     850                 :      18434 :       all = total;
     851                 :      18434 :       all->where = where;
     852                 :            :     }
     853                 :            : 
     854                 :    3045020 :   *result = all;
     855                 :    3045020 :   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                 :    3529280 : gfc_match_expr (gfc_expr **result)
     864                 :            : {
     865                 :    3529280 :   gfc_expr *all, *e;
     866                 :    3529280 :   gfc_user_op *uop;
     867                 :    3529280 :   locus where;
     868                 :    3529280 :   match m;
     869                 :            : 
     870                 :    3529280 :   m = match_level_5 (&all);
     871                 :    3529280 :   if (m != MATCH_YES)
     872                 :            :     return m;
     873                 :            : 
     874                 :    3045160 :   for (;;)
     875                 :            :     {
     876                 :    3045020 :       uop = NULL;
     877                 :    3045020 :       m = match_defined_operator (&uop);
     878                 :    3045020 :       if (m == MATCH_NO)
     879                 :            :         break;
     880                 :        182 :       if (m == MATCH_ERROR)
     881                 :            :         {
     882                 :         36 :           gfc_free_expr (all);
     883                 :         36 :           return MATCH_ERROR;
     884                 :            :         }
     885                 :            : 
     886                 :        146 :       where = gfc_current_locus;
     887                 :            : 
     888                 :        146 :       m = match_level_5 (&e);
     889                 :        146 :       if (m == MATCH_NO)
     890                 :          0 :         gfc_error (expression_syntax);
     891                 :        146 :       if (m != MATCH_YES)
     892                 :            :         {
     893                 :          0 :           gfc_free_expr (all);
     894                 :          0 :           return MATCH_ERROR;
     895                 :            :         }
     896                 :            : 
     897                 :        146 :       all = gfc_get_operator_expr (&where, INTRINSIC_USER, all, e);
     898                 :        146 :       all->value.op.uop = uop;
     899                 :            :     }
     900                 :            : 
     901                 :    3044830 :   *result = all;
     902                 :    3044830 :   return MATCH_YES;
     903                 :            : }

Generated by: LCOV version 1.0

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