===================================================================
@@ -796,20 +796,45 @@ optimize_op (gfc_expr *e)
{
gfc_intrinsic_op op = e->value.op.op;
+ /* Only use new-style comparisions. */
+ switch(op)
+ {
+ case INTRINSIC_EQ_OS:
+ op = INTRINSIC_EQ;
+ break;
+
+ case INTRINSIC_GE_OS:
+ op = INTRINSIC_GE;
+ break;
+
+ case INTRINSIC_LE_OS:
+ op = INTRINSIC_LE;
+ break;
+
+ case INTRINSIC_NE_OS:
+ op = INTRINSIC_NE;
+ break;
+
+ case INTRINSIC_GT_OS:
+ op = INTRINSIC_GT;
+ break;
+
+ case INTRINSIC_LT_OS:
+ op = INTRINSIC_LT;
+ break;
+
+ default:
+ break;
+ }
+
switch (op)
{
case INTRINSIC_EQ:
- case INTRINSIC_EQ_OS:
case INTRINSIC_GE:
- case INTRINSIC_GE_OS:
case INTRINSIC_LE:
- case INTRINSIC_LE_OS:
case INTRINSIC_NE:
- case INTRINSIC_NE_OS:
case INTRINSIC_GT:
- case INTRINSIC_GT_OS:
case INTRINSIC_LT:
- case INTRINSIC_LT_OS:
return optimize_comparison (e, op);
default:
@@ -819,6 +844,61 @@ optimize_op (gfc_expr *e)
return false;
}
+/* Return true if a constant string contains spaces only. */
+
+static bool
+empty_string (gfc_expr *e)
+{
+ int i;
+
+ if (e->ts.type != BT_CHARACTER || e->expr_type != EXPR_CONSTANT)
+ return false;
+
+ for (i=0; i<e->value.character.length; i++)
+ {
+ if (e->value.character.string[i] != ' ')
+ return false;
+ }
+
+ return true;
+}
+
+/* Insert a call to the intrinsic len_trim. Use a different name for
+ the symbol tree so we don't run into trouble when the user has
+ renamed len_trim for some reason. */
+
+static gfc_expr*
+get_len_trim_call (gfc_expr *str, int kind)
+{
+ gfc_expr *fcn;
+ gfc_actual_arglist *actual_arglist, *next;
+
+ fcn = gfc_get_expr ();
+ fcn->expr_type = EXPR_FUNCTION;
+ fcn->value.function.isym = gfc_intrinsic_function_by_id (GFC_ISYM_LEN_TRIM);
+ actual_arglist = gfc_get_actual_arglist ();
+ actual_arglist->expr = str;
+ next = gfc_get_actual_arglist ();
+ next->expr = gfc_get_int_expr (gfc_default_integer_kind, NULL, kind);
+ actual_arglist->next = next;
+
+ fcn->value.function.actual = actual_arglist;
+ fcn->where = str->where;
+ fcn->ts.type = BT_INTEGER;
+ fcn->ts.kind = gfc_charlen_int_kind;
+
+ gfc_get_sym_tree("__internal_len_trim", current_ns, &fcn->symtree, false);
+ fcn->symtree->n.sym->ts = fcn->ts;
+ fcn->symtree->n.sym->attr.flavor = FL_PROCEDURE;
+ fcn->symtree->n.sym->attr.function = 1;
+ fcn->symtree->n.sym->attr.elemental = 1;
+ fcn->symtree->n.sym->attr.referenced = 1;
+ fcn->symtree->n.sym->attr.access = ACCESS_PRIVATE;
+ gfc_commit_symbol (fcn->symtree->n.sym);
+
+ return fcn;
+}
+
/* Optimize expressions for equality. */
static bool
@@ -862,6 +942,46 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op
if (e->rank > 0)
return change;
+ /* Replace a == '' with len_trim(a) == 0 and a /= '' with
+ len_trim(a) != 0 */
+ if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER
+ && (op == INTRINSIC_EQ || op == INTRINSIC_NE))
+ {
+
+ bool empty_op1, empty_op2;
+ empty_op1 = empty_string(op1);
+ empty_op2 = empty_string(op2);
+
+ if (empty_op1 || empty_op2)
+ {
+ gfc_expr *fcn;
+ gfc_expr *zero;
+ gfc_expr *str;
+
+ /* This can only happen when an error for comparing
+ characters of different kinds has already been issued. */
+ if (empty_op1 && empty_op2)
+ return false;
+
+ zero = gfc_get_int_expr (gfc_charlen_int_kind, &e->where, 0);
+ str = empty_op1 ? op2 : op1;
+
+ fcn = get_len_trim_call (str, gfc_charlen_int_kind);
+
+
+ if (empty_op1)
+ gfc_free_expr (op1);
+ else
+ gfc_free_expr (op2);
+
+ op1 = fcn;
+ op2 = zero;
+ e->value.op.op1 = fcn;
+ e->value.op.op2 = zero;
+ }
+ }
+
+
/* Don't compare REAL or COMPLEX expressions when honoring NaNs. */
if (flag_finite_math_only
@@ -935,32 +1055,26 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op
switch (op)
{
case INTRINSIC_EQ:
- case INTRINSIC_EQ_OS:
result = eq == 0;
break;
case INTRINSIC_GE:
- case INTRINSIC_GE_OS:
result = eq >= 0;
break;
case INTRINSIC_LE:
- case INTRINSIC_LE_OS:
result = eq <= 0;
break;
case INTRINSIC_NE:
- case INTRINSIC_NE_OS:
result = eq != 0;
break;
case INTRINSIC_GT:
- case INTRINSIC_GT_OS:
result = eq > 0;
break;
case INTRINSIC_LT:
- case INTRINSIC_LT_OS:
result = eq < 0;
break;
@@ -992,7 +1106,6 @@ optimize_trim (gfc_expr *e)
gfc_expr *a;
gfc_ref *ref;
gfc_expr *fcn;
- gfc_actual_arglist *actual_arglist, *next;
gfc_ref **rr = NULL;
/* Don't do this optimization within an argument list, because
@@ -1041,17 +1154,7 @@ optimize_trim (gfc_expr *e)
/* Build the function call to len_trim(x, gfc_defaul_integer_kind). */
- fcn = gfc_get_expr ();
- fcn->expr_type = EXPR_FUNCTION;
- fcn->value.function.isym =
- gfc_intrinsic_function_by_id (GFC_ISYM_LEN_TRIM);
- actual_arglist = gfc_get_actual_arglist ();
- actual_arglist->expr = gfc_copy_expr (e);
- next = gfc_get_actual_arglist ();
- next->expr = gfc_get_int_expr (gfc_default_integer_kind, NULL,
- gfc_default_integer_kind);
- actual_arglist->next = next;
- fcn->value.function.actual = actual_arglist;
+ fcn = get_len_trim_call (gfc_copy_expr (e), gfc_default_integer_kind);
/* Set the end of the reference to the call to len_trim. */