http://gcc.gnu.org/bugzilla/show_bug.cgi?id=49638
--- Comment #7 from janus at gcc dot gnu.org 2011-08-03 20:17:49 UTC ---
I wonder whether the right thing to do would be to add a general expression
comparison routine like the one below (just a rough sketch so far).
a) Do we have something like this already? I found gfc_compare_expr in arith.c,
but this does not seem to do quite what we need here (e.g. it only handles
constant expressions, etc).
b) Is it overkill and things can be done in a simpler way?
===================================================================
--- gcc/fortran/expr.c (revision 177065)
+++ gcc/fortran/expr.c (working copy)
@@ -255,6 +255,80 @@ gfc_get_iokind_expr (locus *where, io_kind k)
}
+/* Compare two expressions. */
+
+gfc_try
+gfc_cmp_expr (gfc_expr *e1, gfc_expr *e2)
+{
+ if (e1 == NULL && e2 == NULL)
+ return SUCCESS;
+
+ if (e1->expr_type != e2->expr_type)
+ return FAILURE;
+
+ switch (e1->expr_type)
+ {
+ case EXPR_CONSTANT:
+ switch (e1->ts.type)
+ {
+ case BT_INTEGER:
+ if (mpz_cmp (e1->value.integer, e2->value.integer) != 0)
+ return FAILURE;
+ break;
+
+ case BT_REAL:
+ if (mpfr_cmp (e1->value.real, e2->value.real) != 0)
+ return FAILURE;
+ break;
+
+ case BT_COMPLEX:
+ if (mpc_cmp (e1->value.complex, e2->value.complex) != 0)
+ return FAILURE;
+ break;
+
+ case BT_CHARACTER: /* TODO. */
+ case BT_HOLLERITH:
+ case BT_LOGICAL:
+ case BT_DERIVED:
+ case BT_CLASS:
+ break;
+
+ case BT_PROCEDURE:
+ case BT_VOID:
+ /* Should never be reached. */
+ case BT_UNKNOWN:
+ gfc_internal_error ("gfc_copy_expr(): Bad expr node");
+ /* Not reached. */
+ }
+ break;
+
+ case EXPR_VARIABLE:
+ if (strcmp (e1->symtree->n.sym->name, e1->symtree->n.sym->name) != 0)
+ return FAILURE;
+
+ case EXPR_OP:
+ if (e1->value.op.op != e2->value.op.op)
+ return FAILURE;
+ if (gfc_cmp_expr (e1->value.op.op1, e2->value.op.op1) == FAILURE)
+ return FAILURE;
+ if (gfc_cmp_expr (e1->value.op.op2, e2->value.op.op2) == FAILURE)
+ return FAILURE;
+ break;
+
+ case EXPR_FUNCTION: /* TODO. */
+ case EXPR_ARRAY:
+ case EXPR_SUBSTRING:
+ case EXPR_COMPCALL:
+ case EXPR_PPC:
+ case EXPR_STRUCTURE:
+ case EXPR_NULL:
+ break;
+ }
+
+ return SUCCESS;
+}
+
+
