/* 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
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
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"
{
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;
}
{
match m;
gfc_expr *e;
- locus where;
m = gfc_match_literal_constant (result, 0);
if (m != MATCH_NO)
return m;
/* Match an expression in parentheses. */
- where = gfc_current_locus;
-
if (gfc_match_char ('(') != MATCH_YES)
return MATCH_NO;
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)
{
}
-/* 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
locus where;
match m;
+ gfc_gobble_whitespace ();
where = gfc_current_locus;
uop = NULL;
m = match_defined_operator (&uop);
*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;
}
/* 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
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)
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)
}
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;
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:
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;
}