From: Feng Wang Date: Mon, 9 Jan 2006 02:27:45 +0000 (+0000) Subject: fortran ChangeLog entry: X-Git-Tag: releases/gcc-4.2.0~4971 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=0a821a922eadddf1c9a1e8f558ac669df3f2e374;p=thirdparty%2Fgcc.git fortran ChangeLog entry: 2006-01-09 Feng Wang 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 PR fortran/12456 * gfortran.dg/single_char_string.f90: New test. From-SVN: r109489 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 45fb5fe221b2..a745970f3847 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,16 @@ +2006-01-09 Feng Wang + + 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 * simplify.c (gfc_simplify_char): Use UCHAR_MAX instead of literal diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index f21c07342908..e46075eaa8d4 100644 --- a/gcc/fortran/trans-expr.c +++ b/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); diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 699a2947e934..4c6d63abf9a9 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/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)); } diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 2d637bd94063..e0b5138d9199 100644 --- a/gcc/fortran/trans.h +++ b/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); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0743d0ad509d..e29aa6e78990 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2006-01-09 Feng Wang + + * gfortran.dg/single_char_string.f90: New test. + 2006-01-09 Feng Wang * gfortran.dg/ichar_2.f90: New test. diff --git a/gcc/testsuite/gfortran.dg/single_char_string.f90 b/gcc/testsuite/gfortran.dg/single_char_string.f90 new file mode 100644 index 000000000000..479456cfea86 --- /dev/null +++ b/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" } }