fortran ChangeLog entry:

2006-01-09  Feng Wang  <fengwang@nudt.edu.cn>

	PR fortran/12456
	* trans-expr.c (gfc_to_single_character): New function that converts
	string to single character if its length is 1.
	(gfc_build_compare_string):New function that compare string and handle
	single character specially.
	(gfc_conv_expr_op): Use gfc_build_compare_string.
	(gfc_trans_string_copy): Use gfc_to_single_character.
	* trans-intrinsic.c (gfc_conv_intrinsic_strcmp): Use
	gfc_build_compare_string.
	* trans.h (gfc_build_compare_string): Add prototype.

testsuite ChangeLog entry:
2006-01-09  Feng Wang  <fengwang@nudt.edu.cn>

	PR fortran/12456
	* gfortran.dg/single_char_string.f90: New test.

From-SVN: r109489

gcc/fortran/ChangeLog

@@ -1,3 +1,16 @@
+2006-01-09  Feng Wang  <fengwang@nudt.edu.cn>
+
+	PR fortran/12456
+	* trans-expr.c (gfc_to_single_character): New function that converts
+	string to single character if its length is 1.
+	(gfc_build_compare_string):New function that compare string and handle
+	single character specially.
+	(gfc_conv_expr_op): Use gfc_build_compare_string.
+	(gfc_trans_string_copy): Use gfc_to_single_character.
+	* trans-intrinsic.c (gfc_conv_intrinsic_strcmp): Use
+	gfc_build_compare_string.
+	* trans.h (gfc_build_compare_string): Add prototype.
+
 2006-01-09  Feng Wang  <fengwang@nudt.edu.cn>
 
 	* simplify.c (gfc_simplify_char): Use UCHAR_MAX instead of literal

gcc/fortran/trans-expr.c

@@ -901,7 +901,6 @@ gfc_conv_concat_op (gfc_se * se, gfc_expr * expr)
   se->string_length = len;
 }
 
-
 /* Translates an op expression. Common (binary) cases are handled by this
    function, others are passed on. Recursion is used in either case.
    We use the fact that (op1.ts == op2.ts) (except for the power
@@ -1043,23 +1042,15 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr * expr)
   gfc_conv_expr (&rse, expr->value.op.op2);
   gfc_add_block_to_block (&se->pre, &rse.pre);
 
-  /* For string comparisons we generate a library call, and compare the return
-     value with 0.  */
   if (checkstring)
     {
       gfc_conv_string_parameter (&lse);
       gfc_conv_string_parameter (&rse);
-      tmp = NULL_TREE;
-      tmp = gfc_chainon_list (tmp, lse.string_length);
-      tmp = gfc_chainon_list (tmp, lse.expr);
-      tmp = gfc_chainon_list (tmp, rse.string_length);
-      tmp = gfc_chainon_list (tmp, rse.expr);
-
-      /* Build a call for the comparison.  */
-      lse.expr = build_function_call_expr (gfor_fndecl_compare_string, tmp);
-      gfc_add_block_to_block (&lse.post, &rse.post);
 
+      lse.expr = gfc_build_compare_string (lse.string_length, lse.expr,
+					   rse.string_length, rse.expr);
       rse.expr = integer_zero_node;
+      gfc_add_block_to_block (&lse.post, &rse.post);
     }
 
   type = gfc_typenode_for_spec (&expr->ts);
@@ -1078,6 +1069,63 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr * expr)
   gfc_add_block_to_block (&se->post, &lse.post);
 }
 
+/* If a string's length is one, we convert it to a single character.  */
+
+static tree
+gfc_to_single_character (tree len, tree str)
+{
+  gcc_assert (POINTER_TYPE_P (TREE_TYPE (str)));
+
+  if (INTEGER_CST_P (len) && TREE_INT_CST_LOW (len) == 1
+    && TREE_INT_CST_HIGH (len) == 0)
+    {
+      str = fold_convert (pchar_type_node, str);
+      return build_fold_indirect_ref (str);
+    }
+
+  return NULL_TREE;
+}
+
+/* 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)
+{
+  tree sc1;
+  tree sc2;
+  tree type;
+  tree tmp;
+
+  gcc_assert (POINTER_TYPE_P (TREE_TYPE (str1)));
+  gcc_assert (POINTER_TYPE_P (TREE_TYPE (str2)));
+
+  type = gfc_get_int_type (gfc_default_integer_kind);
+
+  sc1 = gfc_to_single_character (len1, str1);
+  sc2 = gfc_to_single_character (len2, str2);
+
+  /* Deal with single character specially.  */
+  if (sc1 != NULL_TREE && sc2 != NULL_TREE)
+    {
+      sc1 = fold_convert (type, sc1);
+      sc2 = fold_convert (type, sc2);
+      tmp = fold_build2 (MINUS_EXPR, type, sc1, sc2);
+    }
+   else
+    {
+      tmp = NULL_TREE;
+      tmp = gfc_chainon_list (tmp, len1);
+      tmp = gfc_chainon_list (tmp, str1);
+      tmp = gfc_chainon_list (tmp, len2);
+      tmp = gfc_chainon_list (tmp, str2);
+
+      /* Build a call for the comparison.  */
+      tmp = build_function_call_expr (gfor_fndecl_compare_string, tmp);
+    }
+
+  return tmp;
+}
 
 static void
 gfc_conv_function_val (gfc_se * se, gfc_symbol * sym)
@@ -1818,6 +1866,17 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlen, tree dest,
 		       tree slen, tree src)
 {
   tree tmp;
+  tree dsc;
+  tree ssc;
+
+  /* Deal with single character specially.  */
+  dsc = gfc_to_single_character (dlen, dest);
+  ssc = gfc_to_single_character (slen, src);
+  if (dsc != NULL_TREE && ssc != NULL_TREE)
+    {
+      gfc_add_modify_expr (block, dsc, ssc);
+      return;
+    }
 
   tmp = NULL_TREE;
   tmp = gfc_chainon_list (tmp, dlen);

gcc/fortran/trans-intrinsic.c

@@ -2267,13 +2267,17 @@ gfc_conv_intrinsic_strcmp (gfc_se * se, gfc_expr * expr, int op)
 {
   tree type;
   tree args;
+  tree arg2;
 
   args = gfc_conv_intrinsic_function_args (se, expr);
-  /* Build a call for the comparison.  */
-  se->expr = build_function_call_expr (gfor_fndecl_compare_string, args);
+  arg2 = TREE_CHAIN (TREE_CHAIN (args));
+
+  se->expr = gfc_build_compare_string (TREE_VALUE (args),
+		TREE_VALUE (TREE_CHAIN (args)), TREE_VALUE (arg2),
+		TREE_VALUE (TREE_CHAIN (arg2)));
 
   type = gfc_typenode_for_spec (&expr->ts);
-  se->expr = build2 (op, type, se->expr,
+  se->expr = fold_build2 (op, type, se->expr,
 		     build_int_cst (TREE_TYPE (se->expr), 0));
 }
 

gcc/fortran/trans.h

@@ -268,6 +268,9 @@ void gfc_make_safe_expr (gfc_se * se);
 /* Makes sure se is suitable for passing as a function string parameter.  */
 void gfc_conv_string_parameter (gfc_se * se);
 
+/* Compare two strings.  */
+tree gfc_build_compare_string (tree, tree, tree, tree);
+
 /* Add an item to the end of TREE_LIST.  */
 tree gfc_chainon_list (tree, tree);
 

gcc/testsuite/ChangeLog

@@ -1,3 +1,7 @@
+2006-01-09  Feng Wang  <fengwang@nudt.edu.cn>
+
+	* gfortran.dg/single_char_string.f90: New test.
+
 2006-01-09  Feng Wang  <fengwang@nudt.edu.cn>
 
 	* gfortran.dg/ichar_2.f90: New test.

gcc/testsuite/gfortran.dg/single_char_string.f90

@@ -0,0 +1,36 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+! PR12456 - Optimize string(k:k) as single character.
+
+Program pr12456
+character a
+character b
+character (len=5) :: c
+integer i
+
+b = 'a'
+a = b
+if (a .ne. 'a') call abort()
+if (a .ne. b) call abort()
+c (3:3) = 'a'
+if (c (3:3) .ne. b) call abort ()
+if (c (3:3) .ne. 'a') call abort ()
+if (LGT (a, c (3:3))) call abort ()
+if (LGT (a, 'a')) call abort ()
+
+i = 3
+c (i:i) = 'a'
+if (c (i:i) .ne. b) call abort ()
+if (c (i:i) .ne. 'a') call abort ()
+if (LGT (a, c (i:i))) call abort ()
+
+if (a .gt. char (255)) call abort ()
+end
+
+! There should not be _gfortran_compare_string and _gfortran_copy_string in
+! the dumped file.
+
+! { dg-final { scan-tree-dump-times "_gfortran_compare_string" 0 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_copy_string" 0 "original" } }
+
+! { dg-final { cleanup-tree-dump "original" } }