2013-03-30 Thomas Koenig <tkoenig@gcc.gnu.org>
authortkoenig <tkoenig@138bc75d-0d04-0410-961f-82ee72b054a4>
Sat, 30 Mar 2013 10:19:02 +0000 (10:19 +0000)
committertkoenig <tkoenig@138bc75d-0d04-0410-961f-82ee72b054a4>
Sat, 30 Mar 2013 10:19:02 +0000 (10:19 +0000)
* trans-expr.c (build_memcmp_call):  New function.
(gfc_build_compare_string):  If the strings
compared have constant and equal lengths and
the strings are kind=1, or, for kind=4 strings,
the test is for (in)equality, use memcmp().

2013-03-30  Thomas Koenig  <tkoenig@gcc.gnu.org>

* gfortran.dg/character_comparison_3.f90:  Adjust for use of memcmp
for constant and equal string lengths.
* gfortran.dg/character_comparison_5.f90:  Likewise.
* gfortran.dg/character_comparison_9.f90:  New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@197261 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/trans-expr.c
gcc/testsuite/gfortran.dg/character_comparison_3.f90
gcc/testsuite/gfortran.dg/character_comparison_5.f90
gcc/testsuite/gfortran.dg/character_comparison_9.f90 [new file with mode: 0644]

index 98a54d9..454755b 100644 (file)
@@ -2689,6 +2689,32 @@ gfc_optimize_len_trim (tree len, tree str, int kind)
   return -1;
 }
 
+/* Helper to build a call to memcmp.  */
+
+static tree
+build_memcmp_call (tree s1, tree s2, tree n)
+{
+  tree tmp;
+
+  if (!POINTER_TYPE_P (TREE_TYPE (s1)))
+    s1 = gfc_build_addr_expr (pvoid_type_node, s1);
+  else
+    s1 = fold_convert (pvoid_type_node, s1);
+
+  if (!POINTER_TYPE_P (TREE_TYPE (s2)))
+    s2 = gfc_build_addr_expr (pvoid_type_node, s2);
+  else
+    s2 = fold_convert (pvoid_type_node, s2);
+
+  n = fold_convert (size_type_node, n);
+
+  tmp = build_call_expr_loc (input_location,
+                            builtin_decl_explicit (BUILT_IN_MEMCMP),
+                            3, s1, s2, n);
+
+  return fold_convert (integer_type_node, tmp);
+}
+
 /* Compare two strings. If they are all single characters, the result is the
    subtraction of them. Otherwise, we build a library call.  */
 
@@ -2730,6 +2756,26 @@ gfc_build_compare_string (tree len1, tree str1, tree len2, tree str2, int kind,
        return integer_one_node;
     }
 
+  /* We can compare via memcpy if the strings are known to be equal
+     in length and they are
+     - kind=1
+     - kind=4 and the comparision is for (in)equality.  */
+
+  if (INTEGER_CST_P (len1) && INTEGER_CST_P (len2)
+      && tree_int_cst_equal (len1, len2)
+      && (kind == 1 || code == EQ_EXPR || code == NE_EXPR))
+    {
+      tree tmp;
+      tree chartype;
+
+      chartype = gfc_get_char_type (kind);
+      tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE(len1),
+                            fold_convert (TREE_TYPE(len1),
+                                          TYPE_SIZE_UNIT(chartype)),
+                            len1);
+      return build_memcmp_call (str1, str2, tmp);
+    }
+
   /* Build a call for the comparison.  */
   if (kind == 1)
     fndecl = gfor_fndecl_compare_string;
index dbcdbef..c5acace 100644 (file)
@@ -25,6 +25,7 @@ program main
   if (c(:k3) == c(:k44)) call abort
 end program main
 
-! { dg-final { scan-tree-dump-times "gfortran_compare_string" 8 "original" } }
+! { dg-final { scan-tree-dump-times "gfortran_compare_string" 6 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_memcmp" 2 "original" } }
 ! { dg-final { cleanup-tree-dump "original" } }
 
index b9ad921..08af59a 100644 (file)
@@ -16,6 +16,6 @@ program main
 end program main
 
 ! { dg-final { scan-tree-dump-times "gfortran_concat_string" 0 "original" } }
-! { dg-final { scan-tree-dump-times "gfortran_compare_string" 2 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_memcmp" 2 "original" } }
 ! { dg-final { cleanup-tree-dump "original" } }
 
diff --git a/gcc/testsuite/gfortran.dg/character_comparison_9.f90 b/gcc/testsuite/gfortran.dg/character_comparison_9.f90
new file mode 100644 (file)
index 0000000..9d17b3c
--- /dev/null
@@ -0,0 +1,16 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+program main
+  character (len=2) :: a, b
+  character (kind=4,len=4) :: c,d
+  a = 'ab'
+  b = 'aa'
+  if (a < b) call abort
+  c = 4_"aaaa"
+  d = 4_"aaab"
+  if (c == d) call abort
+  if (c > d) call abort
+end program main
+! { dg-final { scan-tree-dump-times "_gfortran_compare_string_char4" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_memcmp" 2 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }