frontend-passes: (optimize_lexical_comparison): New function.

2010-04-04  Thomas Koenig  <tkoenig@gcc.gnu.org>

	* frontend-passes: (optimize_lexical_comparison): New function.
	(optimize_expr): Call it.
	(optimize_comparison): Also handle lexical comparison functions.
	Return false instad of -2 for unequal comparison.

2010-04-04  Thomas Koenig  <tkoenig@gcc.gnu.org>

	* gfortran.dg/character_comparison_8.f90:  New test.

From-SVN: r171953

diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index c2f6bd5b0268e38206a7583bd3369eb409eff544..b6f6b4cd02015fb3c76a3d321690617c0376b4df 100644 (file)
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -35,6 +35,7 @@ static void optimize_assignment (gfc_code *);
 static bool optimize_op (gfc_expr *);
 static bool optimize_comparison (gfc_expr *, gfc_intrinsic_op);
 static bool optimize_trim (gfc_expr *);
+static bool optimize_lexical_comparison (gfc_expr *);
 
 /* How deep we are inside an argument list.  */
 
@@ -119,6 +120,9 @@ optimize_expr (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
   if (optimize_trim (*e))
     gfc_simplify_expr (*e, 0);
 
+  if (optimize_lexical_comparison (*e))
+    gfc_simplify_expr (*e, 0);
+
   if ((*e)->expr_type == EXPR_OP && optimize_op (*e))
     gfc_simplify_expr (*e, 0);
 
@@ -483,6 +487,34 @@ strip_function_call (gfc_expr *e)
 
 }
 
+/* Optimization of lexical comparison functions.  */
+
+static bool
+optimize_lexical_comparison (gfc_expr *e)
+{
+  if (e->expr_type != EXPR_FUNCTION || e->value.function.isym == NULL)
+    return false;
+
+  switch (e->value.function.isym->id)
+    {
+    case GFC_ISYM_LLE:
+      return optimize_comparison (e, INTRINSIC_LE);
+
+    case GFC_ISYM_LGE:
+      return optimize_comparison (e, INTRINSIC_GE);
+
+    case GFC_ISYM_LGT:
+      return optimize_comparison (e, INTRINSIC_GT);
+
+    case GFC_ISYM_LLT:
+      return optimize_comparison (e, INTRINSIC_LT);
+
+    default:
+      break;
+    }
+  return false;
+}
+
 /* Recursive optimization of operators.  */
 
 static bool
@@ -522,9 +554,25 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op op)
   bool change;
   int eq;
   bool result;
+  gfc_actual_arglist *firstarg, *secondarg;
 
-  op1 = e->value.op.op1;
-  op2 = e->value.op.op2;
+  if (e->expr_type == EXPR_OP)
+    {
+      firstarg = NULL;
+      secondarg = NULL;
+      op1 = e->value.op.op1;
+      op2 = e->value.op.op2;
+    }
+  else if (e->expr_type == EXPR_FUNCTION)
+    {
+      /* One of the lexical comparision functions.  */
+      firstarg = e->value.function.actual;
+      secondarg = firstarg->next;
+      op1 = firstarg->expr;
+      op2 = secondarg->expr;
+    }
+  else
+    gcc_unreachable ();
 
   /* Strip off unneeded TRIM calls from string comparisons.  */
 
@@ -587,13 +635,21 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op op)
                        && op2_left->expr_type == EXPR_CONSTANT
                        && op1_left->value.character.length
                           != op2_left->value.character.length)
-                   return -2;
+                   return false;
                  else
                    {
                      gfc_free (op1_left);
                      gfc_free (op2_left);
-                     e->value.op.op1 = op1_right;
-                     e->value.op.op2 = op2_right;
+                     if (firstarg)
+                       {
+                         firstarg->expr = op1_right;
+                         secondarg->expr = op2_right;
+                       }
+                     else
+                       {
+                         e->value.op.op1 = op1_right;
+                         e->value.op.op2 = op2_right;
+                       }
                      optimize_comparison (e, op);
                      return true;
                    }
@@ -602,8 +658,17 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op op)
                {
                  gfc_free (op1_right);
                  gfc_free (op2_right);
-                 e->value.op.op1 = op1_left;
-                 e->value.op.op2 = op2_left;
+                 if (firstarg)
+                   {
+                     firstarg->expr = op1_left;
+                     secondarg->expr = op2_left;
+                   }
+                 else
+                   {
+                     e->value.op.op1 = op1_left;
+                     e->value.op.op2 = op2_left;
+                   }
+
                  optimize_comparison (e, op);
                  return true;
                }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index afef468e17b16e5a09bd39c856291a4334ac74d8..6d723f237cf8da0a068ae398d2ace357a6ecdb63 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,14 @@
+2010-04-04  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       * gfortran.dg/character_comparison_8.f90:  New test.
+
+2010-04-04  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       * frontend-passes: (optimize_lexical_comparison): New function.
+       (optimize_expr): Call it.
+       (optimize_comparison): Also handle lexical comparison functions.
+       Return false instad of -2 for unequal comparison.
+
 2011-04-04  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        PR fortran/48412

diff --git a/gcc/testsuite/gfortran.dg/character_comparison_8.f90 b/gcc/testsuite/gfortran.dg/character_comparison_8.f90
new file mode 100644 (file)
index 0000000..54e31a6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/character_comparison_8.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+! { dg-options "-O -fdump-tree-original" }
+! Check for compile-time optimization of LLE and friends.
+program main
+  character(3) :: a
+  a = 'ab'
+  if (.not. LLE(a,a)) call abort
+  if (LLT(a,a)) call abort
+  if (.not. LGE(a,a)) call abort
+  if (LGT(a,a)) call abort
+end program main
+! { dg-final { scan-tree-dump-times "gfortran_compare_string" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+