summaryrefslogtreecommitdiff
path: root/gcc/fortran
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran')
-rw-r--r--gcc/fortran/ChangeLog22
-rw-r--r--gcc/fortran/arith.c12
-rw-r--r--gcc/fortran/dependency.c6
-rw-r--r--gcc/fortran/dump-parse-tree.c8
-rw-r--r--gcc/fortran/expr.c91
-rw-r--r--gcc/fortran/gfortran.h12
-rw-r--r--gcc/fortran/interface.c12
-rw-r--r--gcc/fortran/iresolve.c12
-rw-r--r--gcc/fortran/matchexp.c10
-rw-r--r--gcc/fortran/module.c11
-rw-r--r--gcc/fortran/resolve.c56
-rw-r--r--gcc/fortran/trans-array.c12
-rw-r--r--gcc/fortran/trans-expr.c40
13 files changed, 168 insertions, 136 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b28e7070f63..7bcb12d21c4 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -16,6 +16,28 @@
* symbol.c (gfc_set_default_type): Issue error only once, by setting
and checking 'untyped' attribute.
+ * gfortran.h (gfc_expr): Move 'operator', 'op1', 'op2', and 'uop'
+ fields into new struct 'op' inside the 'value' union.
+ * arith.c (eval_intrinsic): Adapt all users.
+ * dependency.c (gfc_check_dependency): Likewise.
+ * dump-parse-tree.c (gfc_show_expr): Likewise.
+ * expr.c (gfc_get_expr): Don't clear removed fields.
+ (free_expr0, gfc_copy_expr, gfc_type_convert_binary,
+ gfc_is_constant_expr, simplify_intrinsic_op, check_init_expr,
+ check_intrinsic_op): Adapt to new field names.
+ * interface.c (gfc_extend_expr): Likewise. Also explicitly
+ nullify 'esym' and 'isym' fields of new function call.
+ * iresolve.c (gfc_resolve_dot_product, gfc_resolve_matmul):
+ Adapt to renamed structure fields.
+ * matchexp.c (build_node, match_level_1, match_expr): Likewise.
+ * module.c (mio_expr): Likewise.
+ * resolve.c (resolve_operator): Likewise.
+ (gfc_find_forall_index): Likewise. Only look through operands
+ if dealing with EXPR_OP
+ * trans-array.c (gfc_walk_op_expr): Adapt to renamed fields.
+ * trans-expr.c (gfc_conv_unary_op, gfc_conv_power_op,
+ gfc_conv_concat_op, gfc_conv_expr_op): Likewise.
+
2005-02-23 Kazu Hirata <kazu@cs.umass.edu>
* intrinsic.h, st.c: Update copyright.
diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
index 924eea0fb2f..a219ed20675 100644
--- a/gcc/fortran/arith.c
+++ b/gcc/fortran/arith.c
@@ -1598,10 +1598,10 @@ eval_intrinsic (gfc_intrinsic_op operator,
temp.expr_type = EXPR_OP;
gfc_clear_ts (&temp.ts);
- temp.operator = operator;
+ temp.value.op.operator = operator;
- temp.op1 = op1;
- temp.op2 = op2;
+ temp.value.op.op1 = op1;
+ temp.value.op.op2 = op2;
gfc_type_convert_binary (&temp);
@@ -1671,10 +1671,10 @@ runtime:
result->ts = temp.ts;
result->expr_type = EXPR_OP;
- result->operator = operator;
+ result->value.op.operator = operator;
- result->op1 = op1;
- result->op2 = op2;
+ result->value.op.op1 = op1;
+ result->value.op.op2 = op2;
result->where = op1->where;
diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c
index fb0c5764d45..cb5cb50fd92 100644
--- a/gcc/fortran/dependency.c
+++ b/gcc/fortran/dependency.c
@@ -277,11 +277,11 @@ gfc_check_dependency (gfc_expr * expr1, gfc_expr * expr2, gfc_expr ** vars,
switch (expr2->expr_type)
{
case EXPR_OP:
- n = gfc_check_dependency (expr1, expr2->op1, vars, nvars);
+ n = gfc_check_dependency (expr1, expr2->value.op.op1, vars, nvars);
if (n)
return n;
- if (expr2->op2)
- return gfc_check_dependency (expr1, expr2->op2, vars, nvars);
+ if (expr2->value.op.op2)
+ return gfc_check_dependency (expr1, expr2->value.op.op2, vars, nvars);
return 0;
case EXPR_VARIABLE:
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 7af7a625f65..e60b4c082de 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -415,7 +415,7 @@ gfc_show_expr (gfc_expr * p)
case EXPR_OP:
gfc_status ("(");
- switch (p->operator)
+ switch (p->value.op.operator)
{
case INTRINSIC_UPLUS:
gfc_status ("U+ ");
@@ -480,12 +480,12 @@ gfc_show_expr (gfc_expr * p)
("gfc_show_expr(): Bad intrinsic in expression!");
}
- gfc_show_expr (p->op1);
+ gfc_show_expr (p->value.op.op1);
- if (p->op2)
+ if (p->value.op.op2)
{
gfc_status (" ");
- gfc_show_expr (p->op2);
+ gfc_show_expr (p->value.op.op2);
}
gfc_status (")");
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 7231fab1e4f..5867f9bfaa5 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -36,12 +36,9 @@ gfc_get_expr (void)
e = gfc_getmem (sizeof (gfc_expr));
gfc_clear_ts (&e->ts);
- e->op1 = NULL;
- e->op2 = NULL;
e->shape = NULL;
e->ref = NULL;
e->symtree = NULL;
- e->uop = NULL;
return e;
}
@@ -170,10 +167,10 @@ free_expr0 (gfc_expr * e)
break;
case EXPR_OP:
- if (e->op1 != NULL)
- gfc_free_expr (e->op1);
- if (e->op2 != NULL)
- gfc_free_expr (e->op2);
+ if (e->value.op.op1 != NULL)
+ gfc_free_expr (e->value.op.op1);
+ if (e->value.op.op2 != NULL)
+ gfc_free_expr (e->value.op.op2);
break;
case EXPR_FUNCTION:
@@ -437,17 +434,17 @@ gfc_copy_expr (gfc_expr * p)
break;
case EXPR_OP:
- switch (q->operator)
+ switch (q->value.op.operator)
{
case INTRINSIC_NOT:
case INTRINSIC_UPLUS:
case INTRINSIC_UMINUS:
- q->op1 = gfc_copy_expr (p->op1);
+ q->value.op.op1 = gfc_copy_expr (p->value.op.op1);
break;
default: /* Binary operators */
- q->op1 = gfc_copy_expr (p->op1);
- q->op2 = gfc_copy_expr (p->op2);
+ q->value.op.op1 = gfc_copy_expr (p->value.op.op1);
+ q->value.op.op2 = gfc_copy_expr (p->value.op.op2);
break;
}
@@ -584,8 +581,8 @@ gfc_type_convert_binary (gfc_expr * e)
{
gfc_expr *op1, *op2;
- op1 = e->op1;
- op2 = e->op2;
+ op1 = e->value.op.op1;
+ op2 = e->value.op.op2;
if (op1->ts.type == BT_UNKNOWN || op2->ts.type == BT_UNKNOWN)
{
@@ -619,17 +616,17 @@ gfc_type_convert_binary (gfc_expr * e)
e->ts = op1->ts;
/* Special case for ** operator. */
- if (e->operator == INTRINSIC_POWER)
+ if (e->value.op.operator == INTRINSIC_POWER)
goto done;
- gfc_convert_type (e->op2, &e->ts, 2);
+ gfc_convert_type (e->value.op.op2, &e->ts, 2);
goto done;
}
if (op1->ts.type == BT_INTEGER)
{
e->ts = op2->ts;
- gfc_convert_type (e->op1, &e->ts, 2);
+ gfc_convert_type (e->value.op.op1, &e->ts, 2);
goto done;
}
@@ -640,9 +637,9 @@ gfc_type_convert_binary (gfc_expr * e)
else
e->ts.kind = op2->ts.kind;
if (op1->ts.type != BT_COMPLEX || op1->ts.kind != e->ts.kind)
- gfc_convert_type (e->op1, &e->ts, 2);
+ gfc_convert_type (e->value.op.op1, &e->ts, 2);
if (op2->ts.type != BT_COMPLEX || op2->ts.kind != e->ts.kind)
- gfc_convert_type (e->op2, &e->ts, 2);
+ gfc_convert_type (e->value.op.op2, &e->ts, 2);
done:
return;
@@ -665,9 +662,9 @@ gfc_is_constant_expr (gfc_expr * e)
switch (e->expr_type)
{
case EXPR_OP:
- rv = (gfc_is_constant_expr (e->op1)
- && (e->op2 == NULL
- || gfc_is_constant_expr (e->op2)));
+ rv = (gfc_is_constant_expr (e->value.op.op1)
+ && (e->value.op.op2 == NULL
+ || gfc_is_constant_expr (e->value.op.op2)));
break;
@@ -729,11 +726,11 @@ simplify_intrinsic_op (gfc_expr * p, int type)
{
gfc_expr *op1, *op2, *result;
- if (p->operator == INTRINSIC_USER)
+ if (p->value.op.operator == INTRINSIC_USER)
return SUCCESS;
- op1 = p->op1;
- op2 = p->op2;
+ op1 = p->value.op.op1;
+ op2 = p->value.op.op2;
if (gfc_simplify_expr (op1, type) == FAILURE)
return FAILURE;
@@ -745,10 +742,10 @@ simplify_intrinsic_op (gfc_expr * p, int type)
return SUCCESS;
/* Rip p apart */
- p->op1 = NULL;
- p->op2 = NULL;
+ p->value.op.op1 = NULL;
+ p->value.op.op2 = NULL;
- switch (p->operator)
+ switch (p->value.op.operator)
{
case INTRINSIC_UPLUS:
result = gfc_uplus (op1);
@@ -1191,15 +1188,17 @@ static try check_init_expr (gfc_expr *);
static try
check_intrinsic_op (gfc_expr * e, try (*check_function) (gfc_expr *))
{
+ gfc_expr *op1 = e->value.op.op1;
+ gfc_expr *op2 = e->value.op.op2;
- if ((*check_function) (e->op1) == FAILURE)
+ if ((*check_function) (op1) == FAILURE)
return FAILURE;
- switch (e->operator)
+ switch (e->value.op.operator)
{
case INTRINSIC_UPLUS:
case INTRINSIC_UMINUS:
- if (!numeric_type (et0 (e->op1)))
+ if (!numeric_type (et0 (op1)))
goto not_numeric;
break;
@@ -1209,11 +1208,11 @@ check_intrinsic_op (gfc_expr * e, try (*check_function) (gfc_expr *))
case INTRINSIC_GE:
case INTRINSIC_LT:
case INTRINSIC_LE:
- if ((*check_function) (e->op2) == FAILURE)
+ if ((*check_function) (op2) == FAILURE)
return FAILURE;
- if (!(et0 (e->op1) == BT_CHARACTER && et0 (e->op2) == BT_CHARACTER)
- && !(numeric_type (et0 (e->op1)) && numeric_type (et0 (e->op2))))
+ if (!(et0 (op1) == BT_CHARACTER && et0 (op2) == BT_CHARACTER)
+ && !(numeric_type (et0 (op1)) && numeric_type (et0 (op2))))
{
gfc_error ("Numeric or CHARACTER operands are required in "
"expression at %L", &e->where);
@@ -1226,34 +1225,34 @@ check_intrinsic_op (gfc_expr * e, try (*check_function) (gfc_expr *))
case INTRINSIC_TIMES:
case INTRINSIC_DIVIDE:
case INTRINSIC_POWER:
- if ((*check_function) (e->op2) == FAILURE)
+ if ((*check_function) (op2) == FAILURE)
return FAILURE;
- if (!numeric_type (et0 (e->op1)) || !numeric_type (et0 (e->op2)))
+ if (!numeric_type (et0 (op1)) || !numeric_type (et0 (op2)))
goto not_numeric;
- if (e->operator == INTRINSIC_POWER
- && check_function == check_init_expr && et0 (e->op2) != BT_INTEGER)
+ if (e->value.op.operator == INTRINSIC_POWER
+ && check_function == check_init_expr && et0 (op2) != BT_INTEGER)
{
gfc_error ("Exponent at %L must be INTEGER for an initialization "
- "expression", &e->op2->where);
+ "expression", &op2->where);
return FAILURE;
}
break;
case INTRINSIC_CONCAT:
- if ((*check_function) (e->op2) == FAILURE)
+ if ((*check_function) (op2) == FAILURE)
return FAILURE;
- if (et0 (e->op1) != BT_CHARACTER || et0 (e->op2) != BT_CHARACTER)
+ if (et0 (op1) != BT_CHARACTER || et0 (op2) != BT_CHARACTER)
{
gfc_error ("Concatenation operator in expression at %L "
- "must have two CHARACTER operands", &e->op1->where);
+ "must have two CHARACTER operands", &op1->where);
return FAILURE;
}
- if (e->op1->ts.kind != e->op2->ts.kind)
+ if (op1->ts.kind != op2->ts.kind)
{
gfc_error ("Concat operator at %L must concatenate strings of the "
"same kind", &e->where);
@@ -1263,10 +1262,10 @@ check_intrinsic_op (gfc_expr * e, try (*check_function) (gfc_expr *))
break;
case INTRINSIC_NOT:
- if (et0 (e->op1) != BT_LOGICAL)
+ if (et0 (op1) != BT_LOGICAL)
{
gfc_error (".NOT. operator in expression at %L must have a LOGICAL "
- "operand", &e->op1->where);
+ "operand", &op1->where);
return FAILURE;
}
@@ -1276,10 +1275,10 @@ check_intrinsic_op (gfc_expr * e, try (*check_function) (gfc_expr *))
case INTRINSIC_OR:
case INTRINSIC_EQV:
case INTRINSIC_NEQV:
- if ((*check_function) (e->op2) == FAILURE)
+ if ((*check_function) (op2) == FAILURE)
return FAILURE;
- if (et0 (e->op1) != BT_LOGICAL || et0 (e->op2) != BT_LOGICAL)
+ if (et0 (op1) != BT_LOGICAL || et0 (op2) != BT_LOGICAL)
{
gfc_error ("LOGICAL operands are required in expression at %L",
&e->where);
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index f96cff10dde..eb24cba4a8b 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1044,15 +1044,11 @@ typedef struct gfc_expr
int rank;
mpz_t *shape; /* Can be NULL if shape is unknown at compile time */
- gfc_intrinsic_op operator;
-
/* Nonnull for functions and structure constructors */
gfc_symtree *symtree;
- gfc_user_op *uop;
gfc_ref *ref;
- struct gfc_expr *op1, *op2;
locus where;
union
@@ -1070,6 +1066,14 @@ typedef struct gfc_expr
struct
{
+ gfc_intrinsic_op operator;
+ gfc_user_op *uop;
+ struct gfc_expr *op1, *op2;
+ }
+ op;
+
+ struct
+ {
gfc_actual_arglist *actual;
const char *name; /* Points to the ultimate name of the function */
gfc_intrinsic_sym *isym;
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 71555e48cbe..9f163d0efd2 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1640,21 +1640,21 @@ gfc_extend_expr (gfc_expr * e)
sym = NULL;
actual = gfc_get_actual_arglist ();
- actual->expr = e->op1;
+ actual->expr = e->value.op.op1;
- if (e->op2 != NULL)
+ if (e->value.op.op2 != NULL)
{
actual->next = gfc_get_actual_arglist ();
- actual->next->expr = e->op2;
+ actual->next->expr = e->value.op.op2;
}
- i = fold_unary (e->operator);
+ i = fold_unary (e->value.op.operator);
if (i == INTRINSIC_USER)
{
for (ns = gfc_current_ns; ns; ns = ns->parent)
{
- uop = gfc_find_uop (e->uop->name, ns);
+ uop = gfc_find_uop (e->value.op.uop->name, ns);
if (uop == NULL)
continue;
@@ -1687,6 +1687,8 @@ gfc_extend_expr (gfc_expr * e)
e->expr_type = EXPR_FUNCTION;
e->symtree = find_sym_in_symtree (sym);
e->value.function.actual = actual;
+ e->value.function.esym = NULL;
+ e->value.function.isym = NULL;
if (gfc_pure (NULL) && !gfc_pure (sym))
{
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index a4ab2251761..9a30b7df2e1 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -383,9 +383,9 @@ gfc_resolve_dot_product (gfc_expr * f, gfc_expr * a, gfc_expr * b)
{
temp.expr_type = EXPR_OP;
gfc_clear_ts (&temp.ts);
- temp.operator = INTRINSIC_NONE;
- temp.op1 = a;
- temp.op2 = b;
+ temp.value.op.operator = INTRINSIC_NONE;
+ temp.value.op.op1 = a;
+ temp.value.op.op2 = b;
gfc_type_convert_binary (&temp);
f->ts = temp.ts;
}
@@ -753,9 +753,9 @@ gfc_resolve_matmul (gfc_expr * f, gfc_expr * a, gfc_expr * b)
{
temp.expr_type = EXPR_OP;
gfc_clear_ts (&temp.ts);
- temp.operator = INTRINSIC_NONE;
- temp.op1 = a;
- temp.op2 = b;
+ temp.value.op.operator = INTRINSIC_NONE;
+ temp.value.op.op1 = a;
+ temp.value.op.op2 = b;
gfc_type_convert_binary (&temp);
f->ts = temp.ts;
}
diff --git a/gcc/fortran/matchexp.c b/gcc/fortran/matchexp.c
index bde8d603dea..04fd31f3609 100644
--- a/gcc/fortran/matchexp.c
+++ b/gcc/fortran/matchexp.c
@@ -179,11 +179,11 @@ build_node (gfc_intrinsic_op operator, locus * where,
new = gfc_get_expr ();
new->expr_type = EXPR_OP;
- new->operator = operator;
+ new->value.op.operator = operator;
new->where = *where;
- new->op1 = op1;
- new->op2 = op2;
+ new->value.op.op1 = op1;
+ new->value.op.op2 = op2;
return new;
}
@@ -214,7 +214,7 @@ match_level_1 (gfc_expr ** result)
else
{
f = build_node (INTRINSIC_USER, &where, e, NULL);
- f->uop = uop;
+ f->value.op.uop = uop;
*result = f;
}
@@ -873,7 +873,7 @@ gfc_match_expr (gfc_expr ** result)
}
all = build_node (INTRINSIC_USER, &where, all, e);
- all->uop = uop;
+ all->value.op.uop = uop;
}
*result = all;
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index ff3dcffebf9..8df1b9adf63 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -2404,14 +2404,15 @@ mio_expr (gfc_expr ** ep)
switch (e->expr_type)
{
case EXPR_OP:
- e->operator = MIO_NAME(gfc_intrinsic_op) (e->operator, intrinsics);
+ e->value.op.operator
+ = MIO_NAME(gfc_intrinsic_op) (e->value.op.operator, intrinsics);
- switch (e->operator)
+ switch (e->value.op.operator)
{
case INTRINSIC_UPLUS:
case INTRINSIC_UMINUS:
case INTRINSIC_NOT:
- mio_expr (&e->op1);
+ mio_expr (&e->value.op.op1);
break;
case INTRINSIC_PLUS:
@@ -2430,8 +2431,8 @@ mio_expr (gfc_expr ** ep)
case INTRINSIC_GE:
case INTRINSIC_LT:
case INTRINSIC_LE:
- mio_expr (&e->op1);
- mio_expr (&e->op2);
+ mio_expr (&e->value.op.op1);
+ mio_expr (&e->value.op.op2);
break;
default:
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index dd69a983406..ecbd89ddfbc 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -1262,10 +1262,10 @@ resolve_operator (gfc_expr * e)
/* Resolve all subnodes-- give them types. */
- switch (e->operator)
+ switch (e->value.op.operator)
{
default:
- if (gfc_resolve_expr (e->op2) == FAILURE)
+ if (gfc_resolve_expr (e->value.op.op2) == FAILURE)
return FAILURE;
/* Fall through... */
@@ -1273,17 +1273,17 @@ resolve_operator (gfc_expr * e)
case INTRINSIC_NOT:
case INTRINSIC_UPLUS:
case INTRINSIC_UMINUS:
- if (gfc_resolve_expr (e->op1) == FAILURE)
+ if (gfc_resolve_expr (e->value.op.op1) == FAILURE)
return FAILURE;
break;
}
/* Typecheck the new node. */
- op1 = e->op1;
- op2 = e->op2;
+ op1 = e->value.op.op1;
+ op2 = e->value.op.op2;
- switch (e->operator)
+ switch (e->value.op.operator)
{
case INTRINSIC_UPLUS:
case INTRINSIC_UMINUS:
@@ -1296,7 +1296,7 @@ resolve_operator (gfc_expr * e)
}
sprintf (msg, "Operand of unary numeric operator '%s' at %%L is %s",
- gfc_op2string (e->operator), gfc_typename (&e->ts));
+ gfc_op2string (e->value.op.operator), gfc_typename (&e->ts));
goto bad_op;
case INTRINSIC_PLUS:
@@ -1312,7 +1312,7 @@ resolve_operator (gfc_expr * e)
sprintf (msg,
"Operands of binary numeric operator '%s' at %%L are %s/%s",
- gfc_op2string (e->operator), gfc_typename (&op1->ts),
+ gfc_op2string (e->value.op.operator), gfc_typename (&op1->ts),
gfc_typename (&op2->ts));
goto bad_op;
@@ -1345,7 +1345,7 @@ resolve_operator (gfc_expr * e)
}
sprintf (msg, "Operands of logical operator '%s' at %%L are %s/%s",
- gfc_op2string (e->operator), gfc_typename (&op1->ts),
+ gfc_op2string (e->value.op.operator), gfc_typename (&op1->ts),
gfc_typename (&op2->ts));
goto bad_op;
@@ -1393,7 +1393,7 @@ resolve_operator (gfc_expr * e)
}
sprintf (msg, "Operands of comparison operator '%s' at %%L are %s/%s",
- gfc_op2string (e->operator), gfc_typename (&op1->ts),
+ gfc_op2string (e->value.op.operator), gfc_typename (&op1->ts),
gfc_typename (&op2->ts));
goto bad_op;
@@ -1401,10 +1401,10 @@ resolve_operator (gfc_expr * e)
case INTRINSIC_USER:
if (op2 == NULL)
sprintf (msg, "Operand of user operator '%s' at %%L is %s",
- e->uop->name, gfc_typename (&op1->ts));
+ e->value.op.uop->name, gfc_typename (&op1->ts));
else
sprintf (msg, "Operands of user operator '%s' at %%L are %s/%s",
- e->uop->name, gfc_typename (&op1->ts),
+ e->value.op.uop->name, gfc_typename (&op1->ts),
gfc_typename (&op2->ts));
goto bad_op;
@@ -1417,7 +1417,7 @@ resolve_operator (gfc_expr * e)
t = SUCCESS;
- switch (e->operator)
+ switch (e->value.op.operator)
{
case INTRINSIC_PLUS:
case INTRINSIC_MINUS:
@@ -3327,23 +3327,27 @@ gfc_find_forall_index (gfc_expr *expr, gfc_symbol *symbol)
gfc_error ("Unsupported statement while finding forall index in "
"expression");
break;
- default:
+
+ case EXPR_OP:
+ /* Find the FORALL index in the first operand. */
+ if (expr->value.op.op1)
+ {
+ if (gfc_find_forall_index (expr->value.op.op1, symbol) == SUCCESS)
+ return SUCCESS;
+ }
+
+ /* Find the FORALL index in the second operand. */
+ if (expr->value.op.op2)
+ {
+ if (gfc_find_forall_index (expr->value.op.op2, symbol) == SUCCESS)
+ return SUCCESS;
+ }
break;
- }
- /* Find the FORALL index in the first operand. */
- if (expr->op1)
- {
- if (gfc_find_forall_index (expr->op1, symbol) == SUCCESS)
- return SUCCESS;
+ default:
+ break;
}
- /* Find the FORALL index in the second operand. */
- if (expr->op2)
- {
- if (gfc_find_forall_index (expr->op2, symbol) == SUCCESS)
- return SUCCESS;
- }
return FAILURE;
}
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index e281619741d..985abd47836 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -4194,18 +4194,18 @@ gfc_walk_op_expr (gfc_ss * ss, gfc_expr * expr)
gfc_ss *head2;
gfc_ss *newss;
- head = gfc_walk_subexpr (ss, expr->op1);
- if (expr->op2 == NULL)
+ head = gfc_walk_subexpr (ss, expr->value.op.op1);
+ if (expr->value.op.op2 == NULL)
head2 = head;
else
- head2 = gfc_walk_subexpr (head, expr->op2);
+ head2 = gfc_walk_subexpr (head, expr->value.op.op2);
/* All operands are scalar. Pass back and let the caller deal with it. */
if (head2 == ss)
return head2;
/* All operands require scalarization. */
- if (head != ss && (expr->op2 == NULL || head2 != head))
+ if (head != ss && (expr->value.op.op2 == NULL || head2 != head))
return head2;
/* One of the operands needs scalarization, the other is scalar.
@@ -4223,7 +4223,7 @@ gfc_walk_op_expr (gfc_ss * ss, gfc_expr * expr)
gcc_assert (head);
newss->next = ss;
head->next = newss;
- newss->expr = expr->op1;
+ newss->expr = expr->value.op.op1;
}
else /* head2 == head */
{
@@ -4231,7 +4231,7 @@ gfc_walk_op_expr (gfc_ss * ss, gfc_expr * expr)
/* Second operand is scalar. */
newss->next = head2;
head2 = newss;
- newss->expr = expr->op2;
+ newss->expr = expr->value.op.op2;
}
return head2;
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 494faa44135..685a9f97f9e 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -414,7 +414,7 @@ gfc_conv_unary_op (enum tree_code code, gfc_se * se, gfc_expr * expr)
gcc_assert (expr->ts.type != BT_CHARACTER);
/* Initialize the operand. */
gfc_init_se (&operand, se);
- gfc_conv_expr_val (&operand, expr->op1);
+ gfc_conv_expr_val (&operand, expr->value.op.op1);
gfc_add_block_to_block (&se->pre, &operand.pre);
type = gfc_typenode_for_spec (&expr->ts);
@@ -607,25 +607,25 @@ gfc_conv_power_op (gfc_se * se, gfc_expr * expr)
tree tmp;
gfc_init_se (&lse, se);
- gfc_conv_expr_val (&lse, expr->op1);
+ gfc_conv_expr_val (&lse, expr->value.op.op1);
gfc_add_block_to_block (&se->pre, &lse.pre);
gfc_init_se (&rse, se);
- gfc_conv_expr_val (&rse, expr->op2);
+ gfc_conv_expr_val (&rse, expr->value.op.op2);
gfc_add_block_to_block (&se->pre, &rse.pre);
- if (expr->op2->ts.type == BT_INTEGER
- && expr->op2->expr_type == EXPR_CONSTANT)
+ if (expr->value.op.op2->ts.type == BT_INTEGER
+ && expr->value.op.op2->expr_type == EXPR_CONSTANT)
if (gfc_conv_cst_int_power (se, lse.expr, rse.expr))
return;
gfc_int4_type_node = gfc_get_int_type (4);
- kind = expr->op1->ts.kind;
- switch (expr->op2->ts.type)
+ kind = expr->value.op.op1->ts.kind;
+ switch (expr->value.op.op2->ts.type)
{
case BT_INTEGER:
- ikind = expr->op2->ts.kind;
+ ikind = expr->value.op.op2->ts.kind;
switch (ikind)
{
case 1:
@@ -648,7 +648,7 @@ gfc_conv_power_op (gfc_se * se, gfc_expr * expr)
{
case 1:
case 2:
- if (expr->op1->ts.type == BT_INTEGER)
+ if (expr->value.op.op1->ts.type == BT_INTEGER)
lse.expr = convert (gfc_int4_type_node, lse.expr);
else
gcc_unreachable ();
@@ -666,7 +666,7 @@ gfc_conv_power_op (gfc_se * se, gfc_expr * expr)
gcc_unreachable ();
}
- switch (expr->op1->ts.type)
+ switch (expr->value.op.op1->ts.type)
{
case BT_INTEGER:
fndecl = gfor_fndecl_math_powi[kind][ikind].integer;
@@ -780,14 +780,14 @@ gfc_conv_concat_op (gfc_se * se, gfc_expr * expr)
tree args;
tree tmp;
- gcc_assert (expr->op1->ts.type == BT_CHARACTER
- && expr->op2->ts.type == BT_CHARACTER);
+ gcc_assert (expr->value.op.op1->ts.type == BT_CHARACTER
+ && expr->value.op.op2->ts.type == BT_CHARACTER);
gfc_init_se (&lse, se);
- gfc_conv_expr (&lse, expr->op1);
+ gfc_conv_expr (&lse, expr->value.op.op1);
gfc_conv_string_parameter (&lse);
gfc_init_se (&rse, se);
- gfc_conv_expr (&rse, expr->op2);
+ gfc_conv_expr (&rse, expr->value.op.op2);
gfc_conv_string_parameter (&rse);
gfc_add_block_to_block (&se->pre, &lse.pre);
@@ -846,10 +846,10 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr * expr)
checkstring = 0;
lop = 0;
- switch (expr->operator)
+ switch (expr->value.op.operator)
{
case INTRINSIC_UPLUS:
- gfc_conv_expr (se, expr->op1);
+ gfc_conv_expr (se, expr->value.op.op1);
return;
case INTRINSIC_UMINUS:
@@ -951,19 +951,19 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr * expr)
}
/* The only exception to this is **, which is handled separately anyway. */
- gcc_assert (expr->op1->ts.type == expr->op2->ts.type);
+ gcc_assert (expr->value.op.op1->ts.type == expr->value.op.op2->ts.type);
- if (checkstring && expr->op1->ts.type != BT_CHARACTER)
+ if (checkstring && expr->value.op.op1->ts.type != BT_CHARACTER)
checkstring = 0;
/* lhs */
gfc_init_se (&lse, se);
- gfc_conv_expr (&lse, expr->op1);
+ gfc_conv_expr (&lse, expr->value.op.op1);
gfc_add_block_to_block (&se->pre, &lse.pre);
/* rhs */
gfc_init_se (&rse, se);
- gfc_conv_expr (&rse, expr->op2);
+ gfc_conv_expr (&rse, expr->value.op.op2);
gfc_add_block_to_block (&se->pre, &rse.pre);
/* For string comparisons we generate a library call, and compare the return
View Lorry Controller Status