gcc/fortran/matchexp.c

   1 /* Expression parser.
   2    Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008
   3    Free Software Foundation, Inc.
   4    Contributed by Andy Vaught
   5
   6 This file is part of GCC.
   7
   8 GCC is free software; you can redistribute it and/or modify it under
   9 the terms of the GNU General Public License as published by the Free
  10 Software Foundation; either version 3, or (at your option) any later
  11 version.
  12
  13 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
  14 WARRANTY; without even the implied warranty of MERCHANTABILITY or
  15 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  16 for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with GCC; see the file COPYING3.  If not see
  20 <http://www.gnu.org/licenses/>.  */
  21
  22 #include "config.h"
  23 #include "system.h"
  24 #include "gfortran.h"
  25 #include "arith.h"
  26 #include "match.h"
  27
  28 static 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 gfc_match_defined_op_name (char *result, int error_flag)
  37 {
  38   static const char * const badops[] = {
  39     "and", "or", "not", "eqv", "neqv", "eq", "ne", "ge", "le", "lt", "gt",
  40       NULL
  41   };
  42
  43   char name[GFC_MAX_SYMBOL_LEN + 1];
  44   locus old_loc;
  45   match m;
  46   int i;
  47
  48   old_loc = gfc_current_locus;
  49
  50   m = gfc_match (" . %n .", name);
  51   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   if (strcmp (name, "true") == 0 || strcmp (name, "false") == 0)
  58     {
  59       if (error_flag)
  60         goto error;
  61       gfc_current_locus = old_loc;
  62       return MATCH_NO;
  63     }
  64
  65   for (i = 0; badops[i]; i++)
  66     if (strcmp (badops[i], name) == 0)
  67       goto error;
  68
  69   for (i = 0; name[i]; i++)
  70     if (!ISALPHA (name[i]))
  71       {
  72         gfc_error ("Bad character '%c' in OPERATOR name at %C", name[i]);
  73         return MATCH_ERROR;
  74       }
  75
  76   strcpy (result, name);
  77   return MATCH_YES;
  78
  79 error:
  80   gfc_error ("The name '%s' cannot be used as a defined operator at %C",
  81              name);
  82
  83   gfc_current_locus = old_loc;
  84   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 match_defined_operator (gfc_user_op **result)
  93 {
  94   char name[GFC_MAX_SYMBOL_LEN + 1];
  95   match m;
  96
  97   m = gfc_match_defined_op_name (name, 0);
  98   if (m != MATCH_YES)
  99     return m;
 100
 101   *result = gfc_get_uop (name);
 102   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 next_operator (gfc_intrinsic_op t)
 111 {
 112   gfc_intrinsic_op u;
 113   locus old_loc;
 114
 115   old_loc = gfc_current_locus;
 116   if (gfc_match_intrinsic_op (&u) == MATCH_YES && t == u)
 117     return 1;
 118
 119   gfc_current_locus = old_loc;
 120   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 gfc_get_parentheses (gfc_expr *e)
 130 {
 131   gfc_expr *e2;
 132
 133   e2 = gfc_get_expr();
 134   e2->expr_type = EXPR_OP;
 135   e2->ts = e->ts;
 136   e2->rank = e->rank;
 137   e2->where = e->where;
 138   e2->value.op.op = INTRINSIC_PARENTHESES;
 139   e2->value.op.op1 = e;
 140   e2->value.op.op2 = NULL;
 141   return e2;
 142 }
 143
 144
 145 /* Match a primary expression.  */
 146
 147 static match
 148 match_primary (gfc_expr **result)
 149 {
 150   match m;
 151   gfc_expr *e;
 152   locus where;
 153
 154   m = gfc_match_literal_constant (result, 0);
 155   if (m != MATCH_NO)
 156     return m;
 157
 158   m = gfc_match_array_constructor (result);
 159   if (m != MATCH_NO)
 160     return m;
 161
 162   m = gfc_match_rvalue (result);
 163   if (m != MATCH_NO)
 164     return m;
 165
 166   /* Match an expression in parentheses.  */
 167   where = gfc_current_locus;
 168
 169   if (gfc_match_char ('(') != MATCH_YES)
 170     return MATCH_NO;
 171
 172   m = gfc_match_expr (&e);
 173   if (m == MATCH_NO)
 174     goto syntax;
 175   if (m == MATCH_ERROR)
 176     return m;
 177
 178   m = gfc_match_char (')');
 179   if (m == MATCH_NO)
 180     gfc_error ("Expected a right parenthesis in expression at %C");
 181
 182   /* Now we have the expression inside the parentheses, build the
 183      expression pointing to it. By 7.1.7.2, any expression in
 184      parentheses shall be treated as a data entity.  */
 185   *result = gfc_get_parentheses (e);
 186
 187   if (m != MATCH_YES)
 188     {
 189       gfc_free_expr (*result);
 190       return MATCH_ERROR;
 191     }
 192
 193   return MATCH_YES;
 194
 195 syntax:
 196   gfc_error (expression_syntax);
 197   return MATCH_ERROR;
 198 }
 199
 200
 201 /* Build an operator expression node.  */
 202
 203 static gfc_expr *
 204 build_node (gfc_intrinsic_op op, locus *where,
 205             gfc_expr *op1, gfc_expr *op2)
 206 {
 207   gfc_expr *new_expr;
 208
 209   new_expr = gfc_get_expr ();
 210   new_expr->expr_type = EXPR_OP;
 211   new_expr->value.op.op = op;
 212   new_expr->where = *where;
 213
 214   new_expr->value.op.op1 = op1;
 215   new_expr->value.op.op2 = op2;
 216
 217   return new_expr;
 218 }
 219
 220
 221 /* Match a level 1 expression.  */
 222
 223 static match
 224 match_level_1 (gfc_expr **result)
 225 {
 226   gfc_user_op *uop;
 227   gfc_expr *e, *f;
 228   locus where;
 229   match m;
 230
 231   where = gfc_current_locus;
 232   uop = NULL;
 233   m = match_defined_operator (&uop);
 234   if (m == MATCH_ERROR)
 235     return m;
 236
 237   m = match_primary (&e);
 238   if (m != MATCH_YES)
 239     return m;
 240
 241   if (uop == NULL)
 242     *result = e;
 243   else
 244     {
 245       f = build_node (INTRINSIC_USER, &where, e, NULL);
 246       f->value.op.uop = uop;
 247       *result = f;
 248     }
 249
 250   return MATCH_YES;
 251 }
 252
 253
 254 /* As a GNU extension we support an expanded level-2 expression syntax.
 255    Via this extension we support (arbitrary) nesting of unary plus and
 256    minus operations following unary and binary operators, such as **.
 257    The grammar of section 7.1.1.3 is effectively rewritten as:
 258
 259         R704  mult-operand     is level-1-expr [ power-op ext-mult-operand ]
 260         R704' ext-mult-operand is add-op ext-mult-operand
 261                                or mult-operand
 262         R705  add-operand      is add-operand mult-op ext-mult-operand
 263                                or mult-operand
 264         R705' ext-add-operand  is add-op ext-add-operand
 265                                or add-operand
 266         R706  level-2-expr     is [ level-2-expr ] add-op ext-add-operand
 267                                or add-operand
 268  */
 269
 270 static match match_ext_mult_operand (gfc_expr **result);
 271 static match match_ext_add_operand (gfc_expr **result);
 272
 273 static int
 274 match_add_op (void)
 275 {
 276   if (next_operator (INTRINSIC_MINUS))
 277     return -1;
 278   if (next_operator (INTRINSIC_PLUS))
 279     return 1;
 280   return 0;
 281 }
 282
 283
 284 static match
 285 match_mult_operand (gfc_expr **result)
 286 {
 287   gfc_expr *e, *exp, *r;
 288   locus where;
 289   match m;
 290
 291   m = match_level_1 (&e);
 292   if (m != MATCH_YES)
 293     return m;
 294
 295   if (!next_operator (INTRINSIC_POWER))
 296     {
 297       *result = e;
 298       return MATCH_YES;
 299     }
 300
 301   where = gfc_current_locus;
 302
 303   m = match_ext_mult_operand (&exp);
 304   if (m == MATCH_NO)
 305     gfc_error ("Expected exponent in expression at %C");
 306   if (m != MATCH_YES)
 307     {
 308       gfc_free_expr (e);
 309       return MATCH_ERROR;
 310     }
 311
 312   r = gfc_power (e, exp);
 313   if (r == NULL)
 314     {
 315       gfc_free_expr (e);
 316       gfc_free_expr (exp);
 317       return MATCH_ERROR;
 318     }
 319
 320   r->where = where;
 321   *result = r;
 322
 323   return MATCH_YES;
 324 }
 325
 326
 327 static match
 328 match_ext_mult_operand (gfc_expr **result)
 329 {
 330   gfc_expr *all, *e;
 331   locus where;
 332   match m;
 333   int i;
 334
 335   where = gfc_current_locus;
 336   i = match_add_op ();
 337
 338   if (i == 0)
 339     return match_mult_operand (result);
 340
 341   if (gfc_notification_std (GFC_STD_GNU) == ERROR)
 342     {
 343       gfc_error ("Extension: Unary operator following "
 344                  "arithmetic operator (use parentheses) at %C");
 345       return MATCH_ERROR;
 346     }
 347   else
 348     gfc_warning ("Extension: Unary operator following "
 349                  "arithmetic operator (use parentheses) at %C");
 350
 351   m = match_ext_mult_operand (&e);
 352   if (m != MATCH_YES)
 353     return m;
 354
 355   if (i == -1)
 356     all = gfc_uminus (e);
 357   else
 358     all = gfc_uplus (e);
 359
 360   if (all == NULL)
 361     {
 362       gfc_free_expr (e);
 363       return MATCH_ERROR;
 364     }
 365
 366   all->where = where;
 367   *result = all;
 368   return MATCH_YES;
 369 }
 370
 371
 372 static match
 373 match_add_operand (gfc_expr **result)
 374 {
 375   gfc_expr *all, *e, *total;
 376   locus where, old_loc;
 377   match m;
 378   gfc_intrinsic_op i;
 379
 380   m = match_mult_operand (&all);
 381   if (m != MATCH_YES)
 382     return m;
 383
 384   for (;;)
 385     {
 386       /* Build up a string of products or quotients.  */
 387
 388       old_loc = gfc_current_locus;
 389
 390       if (next_operator (INTRINSIC_TIMES))
 391         i = INTRINSIC_TIMES;
 392       else
 393         {
 394           if (next_operator (INTRINSIC_DIVIDE))
 395             i = INTRINSIC_DIVIDE;
 396           else
 397             break;
 398         }
 399
 400       where = gfc_current_locus;
 401
 402       m = match_ext_mult_operand (&e);
 403       if (m == MATCH_NO)
 404         {
 405           gfc_current_locus = old_loc;
 406           break;
 407         }
 408
 409       if (m == MATCH_ERROR)
 410         {
 411           gfc_free_expr (all);
 412           return MATCH_ERROR;
 413         }
 414
 415       if (i == INTRINSIC_TIMES)
 416         total = gfc_multiply (all, e);
 417       else
 418         total = gfc_divide (all, e);
 419
 420       if (total == NULL)
 421         {
 422           gfc_free_expr (all);
 423           gfc_free_expr (e);
 424           return MATCH_ERROR;
 425         }
 426
 427       all = total;
 428       all->where = where;
 429     }
 430
 431   *result = all;
 432   return MATCH_YES;
 433 }
 434
 435
 436 static match
 437 match_ext_add_operand (gfc_expr **result)
 438 {
 439   gfc_expr *all, *e;
 440   locus where;
 441   match m;
 442   int i;
 443
 444   where = gfc_current_locus;
 445   i = match_add_op ();
 446
 447   if (i == 0)
 448     return match_add_operand (result);
 449
 450   if (gfc_notification_std (GFC_STD_GNU) == ERROR)
 451     {
 452       gfc_error ("Extension: Unary operator following "
 453                  "arithmetic operator (use parentheses) at %C");
 454       return MATCH_ERROR;
 455     }
 456   else
 457     gfc_warning ("Extension: Unary operator following "
 458                 "arithmetic operator (use parentheses) at %C");
 459
 460   m = match_ext_add_operand (&e);
 461   if (m != MATCH_YES)
 462     return m;
 463
 464   if (i == -1)
 465     all = gfc_uminus (e);
 466   else
 467     all = gfc_uplus (e);
 468
 469   if (all == NULL)
 470     {
 471       gfc_free_expr (e);
 472       return MATCH_ERROR;
 473     }
 474
 475   all->where = where;
 476   *result = all;
 477   return MATCH_YES;
 478 }
 479
 480
 481 /* Match a level 2 expression.  */
 482
 483 static match
 484 match_level_2 (gfc_expr **result)
 485 {
 486   gfc_expr *all, *e, *total;
 487   locus where;
 488   match m;
 489   int i;
 490
 491   where = gfc_current_locus;
 492   i = match_add_op ();
 493
 494   if (i != 0)
 495     {
 496       m = match_ext_add_operand (&e);
 497       if (m == MATCH_NO)
 498         {
 499           gfc_error (expression_syntax);
 500           m = MATCH_ERROR;
 501         }
 502     }
 503   else
 504     m = match_add_operand (&e);
 505
 506   if (m != MATCH_YES)
 507     return m;
 508
 509   if (i == 0)
 510     all = e;
 511   else
 512     {
 513       if (i == -1)
 514         all = gfc_uminus (e);
 515       else
 516         all = gfc_uplus (e);
 517
 518       if (all == NULL)
 519         {
 520           gfc_free_expr (e);
 521           return MATCH_ERROR;
 522         }
 523     }
 524
 525   all->where = where;
 526
 527   /* Append add-operands to the sum.  */
 528
 529   for (;;)
 530     {
 531       where = gfc_current_locus;
 532       i = match_add_op ();
 533       if (i == 0)
 534         break;
 535
 536       m = match_ext_add_operand (&e);
 537       if (m == MATCH_NO)
 538         gfc_error (expression_syntax);
 539       if (m != MATCH_YES)
 540         {
 541           gfc_free_expr (all);
 542           return MATCH_ERROR;
 543         }
 544
 545       if (i == -1)
 546         total = gfc_subtract (all, e);
 547       else
 548         total = gfc_add (all, e);
 549
 550       if (total == NULL)
 551         {
 552           gfc_free_expr (all);
 553           gfc_free_expr (e);
 554           return MATCH_ERROR;
 555         }
 556
 557       all = total;
 558       all->where = where;
 559     }
 560
 561   *result = all;
 562   return MATCH_YES;
 563 }
 564
 565
 566 /* Match a level three expression.  */
 567
 568 static match
 569 match_level_3 (gfc_expr **result)
 570 {
 571   gfc_expr *all, *e, *total;
 572   locus where;
 573   match m;
 574
 575   m = match_level_2 (&all);
 576   if (m != MATCH_YES)
 577     return m;
 578
 579   for (;;)
 580     {
 581       if (!next_operator (INTRINSIC_CONCAT))
 582         break;
 583
 584       where = gfc_current_locus;
 585
 586       m = match_level_2 (&e);
 587       if (m == MATCH_NO)
 588         {
 589           gfc_error (expression_syntax);
 590           gfc_free_expr (all);
 591         }
 592       if (m != MATCH_YES)
 593         return MATCH_ERROR;
 594
 595       total = gfc_concat (all, e);
 596       if (total == NULL)
 597         {
 598           gfc_free_expr (all);
 599           gfc_free_expr (e);
 600           return MATCH_ERROR;
 601         }
 602
 603       all = total;
 604       all->where = where;
 605     }
 606
 607   *result = all;
 608   return MATCH_YES;
 609 }
 610
 611
 612 /* Match a level 4 expression.  */
 613
 614 static match
 615 match_level_4 (gfc_expr **result)
 616 {
 617   gfc_expr *left, *right, *r;
 618   gfc_intrinsic_op i;
 619   locus old_loc;
 620   locus where;
 621   match m;
 622
 623   m = match_level_3 (&left);
 624   if (m != MATCH_YES)
 625     return m;
 626
 627   old_loc = gfc_current_locus;
 628
 629   if (gfc_match_intrinsic_op (&i) != MATCH_YES)
 630     {
 631       *result = left;
 632       return MATCH_YES;
 633     }
 634
 635   if (i != INTRINSIC_EQ && i != INTRINSIC_NE && i != INTRINSIC_GE
 636       && i != INTRINSIC_LE && i != INTRINSIC_LT && i != INTRINSIC_GT
 637       && i != INTRINSIC_EQ_OS && i != INTRINSIC_NE_OS && i != INTRINSIC_GE_OS
 638       && i != INTRINSIC_LE_OS && i != INTRINSIC_LT_OS && i != INTRINSIC_GT_OS)
 639     {
 640       gfc_current_locus = old_loc;
 641       *result = left;
 642       return MATCH_YES;
 643     }
 644
 645   where = gfc_current_locus;
 646
 647   m = match_level_3 (&right);
 648   if (m == MATCH_NO)
 649     gfc_error (expression_syntax);
 650   if (m != MATCH_YES)
 651     {
 652       gfc_free_expr (left);
 653       return MATCH_ERROR;
 654     }
 655
 656   switch (i)
 657     {
 658     case INTRINSIC_EQ:
 659     case INTRINSIC_EQ_OS:
 660       r = gfc_eq (left, right, i);
 661       break;
 662
 663     case INTRINSIC_NE:
 664     case INTRINSIC_NE_OS:
 665       r = gfc_ne (left, right, i);
 666       break;
 667
 668     case INTRINSIC_LT:
 669     case INTRINSIC_LT_OS:
 670       r = gfc_lt (left, right, i);
 671       break;
 672
 673     case INTRINSIC_LE:
 674     case INTRINSIC_LE_OS:
 675       r = gfc_le (left, right, i);
 676       break;
 677
 678     case INTRINSIC_GT:
 679     case INTRINSIC_GT_OS:
 680       r = gfc_gt (left, right, i);
 681       break;
 682
 683     case INTRINSIC_GE:
 684     case INTRINSIC_GE_OS:
 685       r = gfc_ge (left, right, i);
 686       break;
 687
 688     default:
 689       gfc_internal_error ("match_level_4(): Bad operator");
 690     }
 691
 692   if (r == NULL)
 693     {
 694       gfc_free_expr (left);
 695       gfc_free_expr (right);
 696       return MATCH_ERROR;
 697     }
 698
 699   r->where = where;
 700   *result = r;
 701
 702   return MATCH_YES;
 703 }
 704
 705
 706 static match
 707 match_and_operand (gfc_expr **result)
 708 {
 709   gfc_expr *e, *r;
 710   locus where;
 711   match m;
 712   int i;
 713
 714   i = next_operator (INTRINSIC_NOT);
 715   where = gfc_current_locus;
 716
 717   m = match_level_4 (&e);
 718   if (m != MATCH_YES)
 719     return m;
 720
 721   r = e;
 722   if (i)
 723     {
 724       r = gfc_not (e);
 725       if (r == NULL)
 726         {
 727           gfc_free_expr (e);
 728           return MATCH_ERROR;
 729         }
 730     }
 731
 732   r->where = where;
 733   *result = r;
 734
 735   return MATCH_YES;
 736 }
 737
 738
 739 static match
 740 match_or_operand (gfc_expr **result)
 741 {
 742   gfc_expr *all, *e, *total;
 743   locus where;
 744   match m;
 745
 746   m = match_and_operand (&all);
 747   if (m != MATCH_YES)
 748     return m;
 749
 750   for (;;)
 751     {
 752       if (!next_operator (INTRINSIC_AND))
 753         break;
 754       where = gfc_current_locus;
 755
 756       m = match_and_operand (&e);
 757       if (m == MATCH_NO)
 758         gfc_error (expression_syntax);
 759       if (m != MATCH_YES)
 760         {
 761           gfc_free_expr (all);
 762           return MATCH_ERROR;
 763         }
 764
 765       total = gfc_and (all, e);
 766       if (total == NULL)
 767         {
 768           gfc_free_expr (all);
 769           gfc_free_expr (e);
 770           return MATCH_ERROR;
 771         }
 772
 773       all = total;
 774       all->where = where;
 775     }
 776
 777   *result = all;
 778   return MATCH_YES;
 779 }
 780
 781
 782 static match
 783 match_equiv_operand (gfc_expr **result)
 784 {
 785   gfc_expr *all, *e, *total;
 786   locus where;
 787   match m;
 788
 789   m = match_or_operand (&all);
 790   if (m != MATCH_YES)
 791     return m;
 792
 793   for (;;)
 794     {
 795       if (!next_operator (INTRINSIC_OR))
 796         break;
 797       where = gfc_current_locus;
 798
 799       m = match_or_operand (&e);
 800       if (m == MATCH_NO)
 801         gfc_error (expression_syntax);
 802       if (m != MATCH_YES)
 803         {
 804           gfc_free_expr (all);
 805           return MATCH_ERROR;
 806         }
 807
 808       total = gfc_or (all, e);
 809       if (total == NULL)
 810         {
 811           gfc_free_expr (all);
 812           gfc_free_expr (e);
 813           return MATCH_ERROR;
 814         }
 815
 816       all = total;
 817       all->where = where;
 818     }
 819
 820   *result = all;
 821   return MATCH_YES;
 822 }
 823
 824
 825 /* Match a level 5 expression.  */
 826
 827 static match
 828 match_level_5 (gfc_expr **result)
 829 {
 830   gfc_expr *all, *e, *total;
 831   locus where;
 832   match m;
 833   gfc_intrinsic_op i;
 834
 835   m = match_equiv_operand (&all);
 836   if (m != MATCH_YES)
 837     return m;
 838
 839   for (;;)
 840     {
 841       if (next_operator (INTRINSIC_EQV))
 842         i = INTRINSIC_EQV;
 843       else
 844         {
 845           if (next_operator (INTRINSIC_NEQV))
 846             i = INTRINSIC_NEQV;
 847           else
 848             break;
 849         }
 850
 851       where = gfc_current_locus;
 852
 853       m = match_equiv_operand (&e);
 854       if (m == MATCH_NO)
 855         gfc_error (expression_syntax);
 856       if (m != MATCH_YES)
 857         {
 858           gfc_free_expr (all);
 859           return MATCH_ERROR;
 860         }
 861
 862       if (i == INTRINSIC_EQV)
 863         total = gfc_eqv (all, e);
 864       else
 865         total = gfc_neqv (all, e);
 866
 867       if (total == NULL)
 868         {
 869           gfc_free_expr (all);
 870           gfc_free_expr (e);
 871           return MATCH_ERROR;
 872         }
 873
 874       all = total;
 875       all->where = where;
 876     }
 877
 878   *result = all;
 879   return MATCH_YES;
 880 }
 881
 882
 883 /* Match an expression.  At this level, we are stringing together
 884    level 5 expressions separated by binary operators.  */
 885
 886 match
 887 gfc_match_expr (gfc_expr **result)
 888 {
 889   gfc_expr *all, *e;
 890   gfc_user_op *uop;
 891   locus where;
 892   match m;
 893
 894   m = match_level_5 (&all);
 895   if (m != MATCH_YES)
 896     return m;
 897
 898   for (;;)
 899     {
 900       uop = NULL;
 901       m = match_defined_operator (&uop);
 902       if (m == MATCH_NO)
 903         break;
 904       if (m == MATCH_ERROR)
 905         {
 906           gfc_free_expr (all);
 907           return MATCH_ERROR;
 908         }
 909
 910       where = gfc_current_locus;
 911
 912       m = match_level_5 (&e);
 913       if (m == MATCH_NO)
 914         gfc_error (expression_syntax);
 915       if (m != MATCH_YES)
 916         {
 917           gfc_free_expr (all);
 918           return MATCH_ERROR;
 919         }
 920
 921       all = build_node (INTRINSIC_USER, &where, all, e);
 922       all->value.op.uop = uop;
 923     }
 924
 925   *result = all;
 926   return MATCH_YES;
 927 }