From: tkoenig Date: Fri, 11 May 2012 13:56:06 +0000 (+0000) Subject: 2012-05-11 Thomas Koenig X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=eba36973e2376268fbafb14dbdf9a813b228e650;p=thirdparty%2Fgcc.git 2012-05-11 Thomas Koenig PR fortran/52537 * frontend-passes.c (optimize_op): Change old-style comparison operators to new-style, simplify switch as a result. (empty_string): New function. (get_len_trim_call): New function. (optimize_comparison): If comparing to an empty string, use comparison of len_trim to zero. Use new-style comparison operators only. (optimize_trim): Use get_len_trim_call. 2012-05-11 Thomas Koenig PR fortran/52537 * gfortran.dg/string_compare_4.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@187406 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a488dcac5672..e761ef511540 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,16 @@ +2012-05-11 Thomas Koenig + + PR fortran/52537 + * frontend-passes.c (optimize_op): Change + old-style comparison operators to new-style, simplify + switch as a result. + (empty_string): New function. + (get_len_trim_call): New function. + (optimize_comparison): If comparing to an empty string, + use comparison of len_trim to zero. + Use new-style comparison operators only. + (optimize_trim): Use get_len_trim_call. + 2012-05-11 Manuel López-Ibáñez PR 53063 @@ -7,7 +20,7 @@ (gfc_handle_option): Set it here using handle_generated_option. 2012-05-08 Jan Hubicka - + * trans-common.c (create_common): Do not fake TREE_ASM_WRITTEN. * trans-decl.c (gfc_finish_cray_pointee): Likewise. diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 92a3f8fb3b27..5361d86c5435 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -806,20 +806,45 @@ optimize_op (gfc_expr *e) { gfc_intrinsic_op op = e->value.op.op; + /* Only use new-style comparisions. */ + switch(op) + { + case INTRINSIC_EQ_OS: + op = INTRINSIC_EQ; + break; + + case INTRINSIC_GE_OS: + op = INTRINSIC_GE; + break; + + case INTRINSIC_LE_OS: + op = INTRINSIC_LE; + break; + + case INTRINSIC_NE_OS: + op = INTRINSIC_NE; + break; + + case INTRINSIC_GT_OS: + op = INTRINSIC_GT; + break; + + case INTRINSIC_LT_OS: + op = INTRINSIC_LT; + break; + + default: + break; + } + switch (op) { case INTRINSIC_EQ: - case INTRINSIC_EQ_OS: case INTRINSIC_GE: - case INTRINSIC_GE_OS: case INTRINSIC_LE: - case INTRINSIC_LE_OS: case INTRINSIC_NE: - case INTRINSIC_NE_OS: case INTRINSIC_GT: - case INTRINSIC_GT_OS: case INTRINSIC_LT: - case INTRINSIC_LT_OS: return optimize_comparison (e, op); default: @@ -829,6 +854,63 @@ optimize_op (gfc_expr *e) return false; } + +/* Return true if a constant string contains only blanks. */ + +static bool +empty_string (gfc_expr *e) +{ + int i; + + if (e->ts.type != BT_CHARACTER || e->expr_type != EXPR_CONSTANT) + return false; + + for (i=0; i < e->value.character.length; i++) + { + if (e->value.character.string[i] != ' ') + return false; + } + + return true; +} + + +/* Insert a call to the intrinsic len_trim. Use a different name for + the symbol tree so we don't run into trouble when the user has + renamed len_trim for some reason. */ + +static gfc_expr* +get_len_trim_call (gfc_expr *str, int kind) +{ + gfc_expr *fcn; + gfc_actual_arglist *actual_arglist, *next; + + fcn = gfc_get_expr (); + fcn->expr_type = EXPR_FUNCTION; + fcn->value.function.isym = gfc_intrinsic_function_by_id (GFC_ISYM_LEN_TRIM); + actual_arglist = gfc_get_actual_arglist (); + actual_arglist->expr = str; + next = gfc_get_actual_arglist (); + next->expr = gfc_get_int_expr (gfc_default_integer_kind, NULL, kind); + actual_arglist->next = next; + + fcn->value.function.actual = actual_arglist; + fcn->where = str->where; + fcn->ts.type = BT_INTEGER; + fcn->ts.kind = gfc_charlen_int_kind; + + gfc_get_sym_tree ("__internal_len_trim", current_ns, &fcn->symtree, false); + fcn->symtree->n.sym->ts = fcn->ts; + fcn->symtree->n.sym->attr.flavor = FL_PROCEDURE; + fcn->symtree->n.sym->attr.function = 1; + fcn->symtree->n.sym->attr.elemental = 1; + fcn->symtree->n.sym->attr.referenced = 1; + fcn->symtree->n.sym->attr.access = ACCESS_PRIVATE; + gfc_commit_symbol (fcn->symtree->n.sym); + + return fcn; +} + /* Optimize expressions for equality. */ static bool @@ -872,6 +954,45 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op op) if (e->rank > 0) return change; + /* Replace a == '' with len_trim(a) == 0 and a /= '' with + len_trim(a) != 0 */ + if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER + && (op == INTRINSIC_EQ || op == INTRINSIC_NE)) + { + bool empty_op1, empty_op2; + empty_op1 = empty_string (op1); + empty_op2 = empty_string (op2); + + if (empty_op1 || empty_op2) + { + gfc_expr *fcn; + gfc_expr *zero; + gfc_expr *str; + + /* This can only happen when an error for comparing + characters of different kinds has already been issued. */ + if (empty_op1 && empty_op2) + return false; + + zero = gfc_get_int_expr (gfc_charlen_int_kind, &e->where, 0); + str = empty_op1 ? op2 : op1; + + fcn = get_len_trim_call (str, gfc_charlen_int_kind); + + + if (empty_op1) + gfc_free_expr (op1); + else + gfc_free_expr (op2); + + op1 = fcn; + op2 = zero; + e->value.op.op1 = fcn; + e->value.op.op2 = zero; + } + } + + /* Don't compare REAL or COMPLEX expressions when honoring NaNs. */ if (flag_finite_math_only @@ -945,32 +1066,26 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op op) switch (op) { case INTRINSIC_EQ: - case INTRINSIC_EQ_OS: result = eq == 0; break; case INTRINSIC_GE: - case INTRINSIC_GE_OS: result = eq >= 0; break; case INTRINSIC_LE: - case INTRINSIC_LE_OS: result = eq <= 0; break; case INTRINSIC_NE: - case INTRINSIC_NE_OS: result = eq != 0; break; case INTRINSIC_GT: - case INTRINSIC_GT_OS: result = eq > 0; break; case INTRINSIC_LT: - case INTRINSIC_LT_OS: result = eq < 0; break; @@ -1002,7 +1117,6 @@ optimize_trim (gfc_expr *e) gfc_expr *a; gfc_ref *ref; gfc_expr *fcn; - gfc_actual_arglist *actual_arglist, *next; gfc_ref **rr = NULL; /* Don't do this optimization within an argument list, because @@ -1051,17 +1165,7 @@ optimize_trim (gfc_expr *e) /* Build the function call to len_trim(x, gfc_defaul_integer_kind). */ - fcn = gfc_get_expr (); - fcn->expr_type = EXPR_FUNCTION; - fcn->value.function.isym = - gfc_intrinsic_function_by_id (GFC_ISYM_LEN_TRIM); - actual_arglist = gfc_get_actual_arglist (); - actual_arglist->expr = gfc_copy_expr (e); - next = gfc_get_actual_arglist (); - next->expr = gfc_get_int_expr (gfc_default_integer_kind, NULL, - gfc_default_integer_kind); - actual_arglist->next = next; - fcn->value.function.actual = actual_arglist; + fcn = get_len_trim_call (gfc_copy_expr (e), gfc_default_integer_kind); /* Set the end of the reference to the call to len_trim. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 30e519426f8a..526e3971fc94 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2012-05-11 Thomas Koenig + + PR fortran/52537 + * gfortran.dg/string_compare_4.f90: New test. + 2012-05-11 Rainer Orth * g++.dg/debug/dwarf2/nested-3.C: Allow for ! comments. diff --git a/gcc/testsuite/gfortran.dg/string_compare_4.f90 b/gcc/testsuite/gfortran.dg/string_compare_4.f90 new file mode 100644 index 000000000000..80f1057cff6c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/string_compare_4.f90 @@ -0,0 +1,20 @@ +! { dg-do compile } +! { dg-options "-ffrontend-optimize -fdump-fortran-original" } +! PR fortran/52537 - optimize comparisons with empty strings +program main + implicit none + character(len=10) :: a + character(len=30) :: line + line = 'x' + read (unit=line,fmt='(A)') a + if (trim(a) == '') print *,"empty" + call foo(a) + if (trim(a) == ' ') print *,"empty" +contains + subroutine foo(b) + character(*) :: b + if (b /= ' ') print *,"full" + end subroutine foo +end program main +! { dg-final { scan-tree-dump-times "_gfortran_string_len_trim" 3 "original" } } +! { dg-final { cleanup-tree-dump "original" } }