gfortran.h (gfc_expr): Move 'operator'...
authorTobias Schlüter <tobias.schlueter@physik.uni-muenchen.de>
Wed, 23 Feb 2005 21:34:11 +0000 (22:34 +0100)
committerTobias Schlüter <tobi@gcc.gnu.org>
Wed, 23 Feb 2005 21:34:11 +0000 (22:34 +0100)
* 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.

From-SVN: r95471

13 files changed:
gcc/fortran/ChangeLog
gcc/fortran/arith.c
gcc/fortran/dependency.c
gcc/fortran/dump-parse-tree.c
gcc/fortran/expr.c
gcc/fortran/gfortran.h
gcc/fortran/interface.c
gcc/fortran/iresolve.c
gcc/fortran/matchexp.c
gcc/fortran/module.c
gcc/fortran/resolve.c
gcc/fortran/trans-array.c
gcc/fortran/trans-expr.c

index b28e7070f63b57b69d428d9b8502e9be5877506a..7bcb12d21c4321853863ae342fd17d993da78d6b 100644 (file)
        * 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.
index 924eea0fb2fd5ec5a0901daa030a6e2f76cf2773..a219ed20675da11c1e1fa8d9a31b54c7d09de196 100644 (file)
@@ -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;
 
index fb0c5764d4517ac7ef9d756ffea6adf5f8351d1b..cb5cb50fd92915ccce9d4ac068ce60bdb3baf433 100644 (file)
@@ -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:
index 7af7a625f651f44167dd4fa0f12bba65cf49356e..e60b4c082de2b6137f8d20ed621cd9da49827ff1 100644 (file)
@@ -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 (")");
index 7231fab1e4f460c612173eff48202284b1894bae..5867f9bfaa59517b26177237288577c5b77df228 100644 (file)
@@ -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);
index f96cff10ddebb03688eca2a1a3b54282fd5ba1c0..eb24cba4a8b7669e603b8b09d55f8170fed5085e 100644 (file)
@@ -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
@@ -1068,6 +1064,14 @@ typedef struct gfc_expr
     }
     complex;
 
+    struct
+    {
+      gfc_intrinsic_op operator;
+      gfc_user_op *uop;
+      struct gfc_expr *op1, *op2;
+    }
+    op;
+
     struct
     {
       gfc_actual_arglist *actual;
index 71555e48cbe30e06d2e1ede43e63768a852b45ae..9f163d0efd2f7d1b0ff2a3775ef63a8c0b2fa1f7 100644 (file)
@@ -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))
     {
index a4ab225176134e6fd69891fd02375599e7bbdb07..9a30b7df2e160b87dc562a28d32bf27466fcbf7d 100644 (file)
@@ -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;
     }
index bde8d603deaea5492e183f45f8be21f6e0d5780c..04fd31f3609ad6a180400e5288606dda9c20062d 100644 (file)
@@ -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;
index ff3dcffebf91f91455bd7d350bb47beacf9c9eb7..8df1b9adf63af6c72efb798343414cb5c8f1777a 100644 (file)
@@ -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:
index dd69a98340643674b56102742cfeea2f75d7b77b..ecbd89ddfbc3fd0172987cd88074f46306517b05 100644 (file)
@@ -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;
 }
 
index e281619741d34dff0f4f13d63dbc2f3503f24a64..985abd478360986c427510b82d6cc34d9cc89a32 100644 (file)
@@ -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;
index 494faa44135d26c8ee46f04b09a3707377e6ff49..685a9f97f9e796e3e7942f34ecc74a4ef4c788f9 100644 (file)
@@ -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