diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c2103314bef..e25d4e38124 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2010-12-31 Thomas Koenig + + PR fortran/47065 + * frontend-passes.c (count_arglist): Static variable to + count the nesting of argument lists. + (optimize_code): Set count_arglist to 1 if within a call + statement, to 0 otherwise. + (optimize_trim): New function. + (optimize_expr): Adjust count_arglist. Call optimize_trim. + 2010-12-31 Thomas Koenig PR fortran/45338 diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 339458e2d62..0777dba6869 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -34,6 +34,11 @@ static void optimize_namespace (gfc_namespace *); static void optimize_assignment (gfc_code *); static bool optimize_op (gfc_expr *); static bool optimize_comparison (gfc_expr *, gfc_intrinsic_op); +static bool optimize_trim (gfc_expr *); + +/* How deep we are inside an argument list. */ + +static int count_arglist; /* Entry point - run all passes for a namespace. So far, only an optimization pass is run. */ @@ -56,7 +61,18 @@ static int optimize_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED, void *data ATTRIBUTE_UNUSED) { - if ((*c)->op == EXEC_ASSIGN) + + gfc_exec_op op; + + op = (*c)->op; + + if (op == EXEC_CALL || op == EXEC_COMPCALL || op == EXEC_ASSIGN_CALL + || op == EXEC_CALL_PPC) + count_arglist = 1; + else + count_arglist = 0; + + if (op == EXEC_ASSIGN) optimize_assignment (*c); return 0; } @@ -68,8 +84,25 @@ static int optimize_expr (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, void *data ATTRIBUTE_UNUSED) { + bool function_expr; + + if ((*e)->expr_type == EXPR_FUNCTION) + { + count_arglist ++; + function_expr = true; + } + else + function_expr = false; + + if (optimize_trim (*e)) + gfc_simplify_expr (*e, 0); + if ((*e)->expr_type == EXPR_OP && optimize_op (*e)) gfc_simplify_expr (*e, 0); + + if (function_expr) + count_arglist --; + return 0; } @@ -395,6 +428,76 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op op) return false; } +/* Optimize a trim function by replacing it with an equivalent substring + involving a call to len_trim. This only works for expressions where + variables are trimmed. Return true if anything was modified. */ + +static bool +optimize_trim (gfc_expr *e) +{ + gfc_expr *a; + gfc_ref *ref; + gfc_expr *fcn; + gfc_actual_arglist *actual_arglist, *next; + + /* Don't do this optimization within an argument list, because + otherwise aliasing issues may occur. */ + + if (count_arglist != 1) + return false; + + if (e->ts.type != BT_CHARACTER || e->expr_type != EXPR_FUNCTION + || e->value.function.isym == NULL + || e->value.function.isym->id != GFC_ISYM_TRIM) + return false; + + a = e->value.function.actual->expr; + + if (a->expr_type != EXPR_VARIABLE) + return false; + + if (a->ref) + { + /* FIXME - also handle substring references, by modifying the + reference itself. Make sure not to evaluate functions in + the references twice. */ + return false; + } + else + { + strip_function_call (e); + + /* Create the reference. */ + + ref = gfc_get_ref (); + ref->type = REF_SUBSTRING; + + /* Set the start of the reference. */ + + ref->u.ss.start = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1); + + /* 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; + + /* Set the end of the reference to the call to len_trim. */ + + ref->u.ss.end = fcn; + e->ref = ref; + return true; + } +} + #define WALK_SUBEXPR(NODE) \ do \ { \ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 4e4601de1bb..82959637820 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2010-12-31 Thomas Koenig + + PR fortran/47065 + * gfortran.dg/trim_optimize_3.f90: New test. + * gfortran.dg/trim_optimize_4.f90: New test. + 2010-12-31 Thomas Koenig PR fortran/45338 diff --git a/gcc/testsuite/gfortran.dg/trim_optimize_3.f90 b/gcc/testsuite/gfortran.dg/trim_optimize_3.f90 new file mode 100644 index 00000000000..33cf8b2b940 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/trim_optimize_3.f90 @@ -0,0 +1,16 @@ +! { dg-do run } +! { dg-options "-O -fdump-tree-original" } +! PR 47065 - replace trim with substring expressions. +program main + character(len=10) :: a, b + character(kind=4,len=10) :: a4, b4 + character(len=100) :: line + a = 'bcd' + b = trim(a) // 'x' + if (b /= 'bcdx') call abort + a4 = 4_"bcd" + b4 = trim(a4) // 4_'x' + if (b4 /= 4_'bcdx') call abort +end +! { dg-final { scan-tree-dump-times "string_len_trim" 2 "original" } } +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/trim_optimize_4.f90 b/gcc/testsuite/gfortran.dg/trim_optimize_4.f90 new file mode 100644 index 00000000000..41c65b10bcd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/trim_optimize_4.f90 @@ -0,0 +1,25 @@ +! { dg-do run } +! PR 47065 - make sure that trim optimization does not lead to +! wrong-code with aliasing. +! Test case provided by Tobias Burnus. +program main + character(len=12) :: str + str = '1234567890' + call sub(trim(str), str) + ! Should print '12345 ' + if (str /= '12345 ') call abort + call two(trim(str)) + if (str /= '123 ') call abort +contains + subroutine sub(a,b) + character(len=*), intent(in) :: a + character(len=*), intent(out) :: b + b = '' + b = a(1:5) + end subroutine sub + subroutine two(a) + character(len=*), intent(in) :: a + str = '' + str(1:3) = a(1:3) + end subroutine two +end program main