trans.h (gfc_build_compare_string): Add CODE argument.

	* trans.h (gfc_build_compare_string): Add CODE argument.
	* trans-intrinsic.c (gfc_conv_intrinsic_strcmp): Pass OP to
	gfc_build_compare_string.
	* trans-expr.c (gfc_conv_expr_op): Pass CODE to
	gfc_build_compare_string.
	(string_to_single_character): Rename len variable to length.
	(gfc_optimize_len_trim): New function.
	(gfc_build_compare_string): Add CODE argument.  If it is EQ_EXPR
	or NE_EXPR and one of the strings is string literal with LEN_TRIM
	bigger than the length of the other string, they compare unequal.

From-SVN: r162208

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d6b150a..ea1a501 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,16 @@
+2010-07-15  Jakub Jelinek  <jakub@redhat.com>
+
+       * trans.h (gfc_build_compare_string): Add CODE argument.
+       * trans-intrinsic.c (gfc_conv_intrinsic_strcmp): Pass OP to
+       gfc_build_compare_string.
+       * trans-expr.c (gfc_conv_expr_op): Pass CODE to
+       gfc_build_compare_string.
+       (string_to_single_character): Rename len variable to length.
+       (gfc_optimize_len_trim): New function.
+       (gfc_build_compare_string): Add CODE argument.  If it is EQ_EXPR
+       or NE_EXPR and one of the strings is string literal with LEN_TRIM
+       bigger than the length of the other string, they compare unequal.
+
 2010-07-14  Mikael Morin  <mikael@gcc.gnu.org>
 
        * trans-array.c (gfc_conv_section_upper_bound): Remove

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 9857f44..02cc241 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1365,7 +1365,8 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr * expr)
 
       lse.expr = gfc_build_compare_string (lse.string_length, lse.expr,
                                           rse.string_length, rse.expr,
-                                          expr->value.op.op1->ts.kind);
+                                          expr->value.op.op1->ts.kind,
+                                          code);
       rse.expr = build_int_cst (TREE_TYPE (lse.expr), 0);
       gfc_add_block_to_block (&lse.post, &rse.post);
     }
@@ -1418,10 +1419,10 @@ string_to_single_character (tree len, tree str, int kind)
       if (TREE_CODE (ret) == INTEGER_CST)
        {
          tree string_cst = TREE_OPERAND (TREE_OPERAND (str, 0), 0);
-         int i, len = TREE_STRING_LENGTH (string_cst);
+         int i, length = TREE_STRING_LENGTH (string_cst);
          const char *ptr = TREE_STRING_POINTER (string_cst);
 
-         for (i = 1; i < len; i++)
+         for (i = 1; i < length; i++)
            if (ptr[i] != ' ')
              return NULL_TREE;
 
@@ -1494,16 +1495,51 @@ gfc_conv_scalar_char_value (gfc_symbol *sym, gfc_se *se, gfc_expr **expr)
     }
 }
 
+/* Helper function for gfc_build_compare_string.  Return LEN_TRIM value
+   if STR is a string literal, otherwise return -1.  */
+
+static int
+gfc_optimize_len_trim (tree len, tree str, int kind)
+{
+  if (kind == 1
+      && TREE_CODE (str) == ADDR_EXPR
+      && TREE_CODE (TREE_OPERAND (str, 0)) == ARRAY_REF
+      && TREE_CODE (TREE_OPERAND (TREE_OPERAND (str, 0), 0)) == STRING_CST
+      && array_ref_low_bound (TREE_OPERAND (str, 0))
+        == TREE_OPERAND (TREE_OPERAND (str, 0), 1)
+      && TREE_INT_CST_LOW (len) >= 1
+      && TREE_INT_CST_LOW (len)
+        == (unsigned HOST_WIDE_INT)
+           TREE_STRING_LENGTH (TREE_OPERAND (TREE_OPERAND (str, 0), 0)))
+    {
+      tree folded = fold_convert (gfc_get_pchar_type (kind), str);
+      folded = build_fold_indirect_ref_loc (input_location, folded);
+      if (TREE_CODE (folded) == INTEGER_CST)
+       {
+         tree string_cst = TREE_OPERAND (TREE_OPERAND (str, 0), 0);
+         int length = TREE_STRING_LENGTH (string_cst);
+         const char *ptr = TREE_STRING_POINTER (string_cst);
+
+         for (; length > 0; length--)
+           if (ptr[length - 1] != ' ')
+             break;
+
+         return length;
+       }
+    }
+  return -1;
+}
 
 /* Compare two strings. If they are all single characters, the result is the
    subtraction of them. Otherwise, we build a library call.  */
 
 tree
-gfc_build_compare_string (tree len1, tree str1, tree len2, tree str2, int kind)
+gfc_build_compare_string (tree len1, tree str1, tree len2, tree str2, int kind,
+                         enum tree_code code)
 {
   tree sc1;
   tree sc2;
-  tree tmp;
+  tree fndecl;
 
   gcc_assert (POINTER_TYPE_P (TREE_TYPE (str1)));
   gcc_assert (POINTER_TYPE_P (TREE_TYPE (str2)));
@@ -1516,25 +1552,34 @@ gfc_build_compare_string (tree len1, tree str1, tree len2, tree str2, int kind)
       /* Deal with single character specially.  */
       sc1 = fold_convert (integer_type_node, sc1);
       sc2 = fold_convert (integer_type_node, sc2);
-      tmp = fold_build2 (MINUS_EXPR, integer_type_node, sc1, sc2);
+      return fold_build2 (MINUS_EXPR, integer_type_node, sc1, sc2);
     }
-  else
-    {
-      /* Build a call for the comparison.  */
-      tree fndecl;
 
-      if (kind == 1)
-       fndecl = gfor_fndecl_compare_string;
-      else if (kind == 4)
-       fndecl = gfor_fndecl_compare_string_char4;
-      else
-       gcc_unreachable ();
-
-      tmp = build_call_expr_loc (input_location,
-                            fndecl, 4, len1, str1, len2, str2);
+  if ((code == EQ_EXPR || code == NE_EXPR)
+      && optimize
+      && INTEGER_CST_P (len1) && INTEGER_CST_P (len2))
+    {
+      /* If one string is a string literal with LEN_TRIM longer
+        than the length of the second string, the strings
+        compare unequal.  */
+      int len = gfc_optimize_len_trim (len1, str1, kind);
+      if (len > 0 && compare_tree_int (len2, len) < 0)
+       return integer_one_node;
+      len = gfc_optimize_len_trim (len2, str2, kind);
+      if (len > 0 && compare_tree_int (len1, len) < 0)
+       return integer_one_node;
     }
 
-  return tmp;
+  /* Build a call for the comparison.  */
+  if (kind == 1)
+    fndecl = gfor_fndecl_compare_string;
+  else if (kind == 4)
+    fndecl = gfor_fndecl_compare_string_char4;
+  else
+    gcc_unreachable ();
+
+  return build_call_expr_loc (input_location, fndecl, 4,
+                             len1, str1, len2, str2);
 }
 
 

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index de21168..c277e8e 100644 (file)
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -3998,7 +3998,8 @@ gfc_conv_intrinsic_strcmp (gfc_se * se, gfc_expr * expr, enum tree_code op)
 
   se->expr
     = gfc_build_compare_string (args[0], args[1], args[2], args[3],
-                               expr->value.function.actual->expr->ts.kind);
+                               expr->value.function.actual->expr->ts.kind,
+                               op);
   se->expr = fold_build2 (op, gfc_typenode_for_spec (&expr->ts), se->expr,
                          build_int_cst (TREE_TYPE (se->expr), 0));
 }

diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index cd80282..c30d3b8 100644 (file)
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -279,7 +279,7 @@ void gfc_make_safe_expr (gfc_se * se);
 void gfc_conv_string_parameter (gfc_se * se);
 
 /* Compare two strings.  */
-tree gfc_build_compare_string (tree, tree, tree, tree, int);
+tree gfc_build_compare_string (tree, tree, tree, tree, int, enum tree_code);
 
 /* Add an item to the end of TREE_LIST.  */
 tree gfc_chainon_list (tree, tree);