OSDN Git Service

PR fortran/50409
[pf3gnuchains/gcc-fork.git] / gcc / fortran / matchexp.c
index 6e1a5a4..cd70dc0 100644 (file)
@@ -1,5 +1,5 @@
 /* Expression parser.
-   Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007
+   Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008, 2009, 2010
    Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
@@ -7,7 +7,7 @@ This file is part of GCC.
 
 GCC is free software; you can redistribute it and/or modify it under
 the terms of the GNU General Public License as published by the Free
-Software Foundation; either version 2, or (at your option) any later
+Software Foundation; either version 3, or (at your option) any later
 version.
 
 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
@@ -16,9 +16,8 @@ FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
 for more details.
 
 You should have received a copy of the GNU General Public License
-along with GCC; see the file COPYING.  If not, write to the Free
-Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
-02110-1301, USA.  */
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
 
 #include "config.h"
 #include "system.h"
@@ -131,14 +130,10 @@ gfc_get_parentheses (gfc_expr *e)
 {
   gfc_expr *e2;
 
-  e2 = gfc_get_expr();
-  e2->expr_type = EXPR_OP;
+  e2 = gfc_get_operator_expr (&e->where, INTRINSIC_PARENTHESES, e, NULL);
   e2->ts = e->ts;
   e2->rank = e->rank;
-  e2->where = e->where;
-  e2->value.op.operator = INTRINSIC_PARENTHESES;
-  e2->value.op.op1 = e;
-  e2->value.op.op2 = NULL;
+
   return e2;
 }
 
@@ -150,7 +145,6 @@ match_primary (gfc_expr **result)
 {
   match m;
   gfc_expr *e;
-  locus where;
 
   m = gfc_match_literal_constant (result, 0);
   if (m != MATCH_NO)
@@ -165,8 +159,6 @@ match_primary (gfc_expr **result)
     return m;
 
   /* Match an expression in parentheses.  */
-  where = gfc_current_locus;
-
   if (gfc_match_char ('(') != MATCH_YES)
     return MATCH_NO;
 
@@ -181,13 +173,9 @@ match_primary (gfc_expr **result)
     gfc_error ("Expected a right parenthesis in expression at %C");
 
   /* Now we have the expression inside the parentheses, build the
-     expression pointing to it. By 7.1.7.2 the integrity of
-     parentheses is only conserved in numerical calculations, so we
-     don't bother to keep the parentheses otherwise.  */
-  if(!gfc_numeric_ts(&e->ts))
-    *result = e;
-  else
-    *result = gfc_get_parentheses (e);
+     expression pointing to it. By 7.1.7.2, any expression in
+     parentheses shall be treated as a data entity.  */
+  *result = gfc_get_parentheses (e);
 
   if (m != MATCH_YES)
     {
@@ -203,26 +191,6 @@ syntax:
 }
 
 
-/* Build an operator expression node.  */
-
-static gfc_expr *
-build_node (gfc_intrinsic_op operator, locus *where,
-           gfc_expr *op1, gfc_expr *op2)
-{
-  gfc_expr *new;
-
-  new = gfc_get_expr ();
-  new->expr_type = EXPR_OP;
-  new->value.op.operator = operator;
-  new->where = *where;
-
-  new->value.op.op1 = op1;
-  new->value.op.op2 = op2;
-
-  return new;
-}
-
-
 /* Match a level 1 expression.  */
 
 static match
@@ -233,6 +201,7 @@ match_level_1 (gfc_expr **result)
   locus where;
   match m;
 
+  gfc_gobble_whitespace ();
   where = gfc_current_locus;
   uop = NULL;
   m = match_defined_operator (&uop);
@@ -247,7 +216,7 @@ match_level_1 (gfc_expr **result)
     *result = e;
   else
     {
-      f = build_node (INTRINSIC_USER, &where, e, NULL);
+      f = gfc_get_operator_expr (&where, INTRINSIC_USER, e, NULL);
       f->value.op.uop = uop;
       *result = f;
     }
@@ -259,7 +228,7 @@ match_level_1 (gfc_expr **result)
 /* As a GNU extension we support an expanded level-2 expression syntax.
    Via this extension we support (arbitrary) nesting of unary plus and
    minus operations following unary and binary operators, such as **.
-   The grammar of section 7.1.1.3 is effectively rewitten as:
+   The grammar of section 7.1.1.3 is effectively rewritten as:
 
        R704  mult-operand     is level-1-expr [ power-op ext-mult-operand ]
        R704' ext-mult-operand is add-op ext-mult-operand
@@ -343,10 +312,15 @@ match_ext_mult_operand (gfc_expr **result)
   if (i == 0)
     return match_mult_operand (result);
 
-  if (gfc_notify_std (GFC_STD_GNU, "Extension: Unary operator following "
-                     "arithmetic operator (use parentheses) at %C")
-      == FAILURE)
-    return MATCH_ERROR;
+  if (gfc_notification_std (GFC_STD_GNU) == ERROR)
+    {
+      gfc_error ("Extension: Unary operator following "
+                "arithmetic operator (use parentheses) at %C");
+      return MATCH_ERROR;
+    }
+  else
+    gfc_warning ("Extension: Unary operator following "
+                "arithmetic operator (use parentheses) at %C");
 
   m = match_ext_mult_operand (&e);
   if (m != MATCH_YES)
@@ -447,10 +421,15 @@ match_ext_add_operand (gfc_expr **result)
   if (i == 0)
     return match_add_operand (result);
 
-  if (gfc_notify_std (GFC_STD_GNU, "Extension: Unary operator following "
-                     "arithmetic operator (use parentheses) at %C")
-      == FAILURE)
-    return MATCH_ERROR;
+  if (gfc_notification_std (GFC_STD_GNU) == ERROR)
+    {
+      gfc_error ("Extension: Unary operator following "
+                "arithmetic operator (use parentheses) at %C");
+      return MATCH_ERROR;
+    }
+  else
+    gfc_warning ("Extension: Unary operator following "
+               "arithmetic operator (use parentheses) at %C");
 
   m = match_ext_add_operand (&e);
   if (m != MATCH_YES)
@@ -628,7 +607,9 @@ match_level_4 (gfc_expr **result)
     }
 
   if (i != INTRINSIC_EQ && i != INTRINSIC_NE && i != INTRINSIC_GE
-      && i != INTRINSIC_LE && i != INTRINSIC_LT && i != INTRINSIC_GT)
+      && i != INTRINSIC_LE && i != INTRINSIC_LT && i != INTRINSIC_GT
+      && i != INTRINSIC_EQ_OS && i != INTRINSIC_NE_OS && i != INTRINSIC_GE_OS
+      && i != INTRINSIC_LE_OS && i != INTRINSIC_LT_OS && i != INTRINSIC_GT_OS)
     {
       gfc_current_locus = old_loc;
       *result = left;
@@ -649,27 +630,33 @@ match_level_4 (gfc_expr **result)
   switch (i)
     {
     case INTRINSIC_EQ:
-      r = gfc_eq (left, right);
+    case INTRINSIC_EQ_OS:
+      r = gfc_eq (left, right, i);
       break;
 
     case INTRINSIC_NE:
-      r = gfc_ne (left, right);
+    case INTRINSIC_NE_OS:
+      r = gfc_ne (left, right, i);
       break;
 
     case INTRINSIC_LT:
-      r = gfc_lt (left, right);
+    case INTRINSIC_LT_OS:
+      r = gfc_lt (left, right, i);
       break;
 
     case INTRINSIC_LE:
-      r = gfc_le (left, right);
+    case INTRINSIC_LE_OS:
+      r = gfc_le (left, right, i);
       break;
 
     case INTRINSIC_GT:
-      r = gfc_gt (left, right);
+    case INTRINSIC_GT_OS:
+      r = gfc_gt (left, right, i);
       break;
 
     case INTRINSIC_GE:
-      r = gfc_ge (left, right);
+    case INTRINSIC_GE_OS:
+      r = gfc_ge (left, right, i);
       break;
 
     default:
@@ -905,7 +892,7 @@ gfc_match_expr (gfc_expr **result)
          return MATCH_ERROR;
        }
 
-      all = build_node (INTRINSIC_USER, &where, all, e);
+      all = gfc_get_operator_expr (&where, INTRINSIC_USER, all, e);
       all->value.op.uop = uop;
     }