From 42a2717cb7efd5f685f158304807668b30307cb0 Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Sun, 22 May 2011 10:38:09 +0000 Subject: [PATCH] frontend-passes.c (cfe_register_funcs): Also register character functions if their charlens are known and constant. 2011-05-22 Thomas Koenig * frontend-passes.c (cfe_register_funcs): Also register character functions if their charlens are known and constant. Also register allocatable functions. 2011-05-22 Thomas Koenig * gfortran.dg/function_optimize_8.f90: New test case. From-SVN: r174027 --- gcc/fortran/ChangeLog | 6 ++++ gcc/fortran/frontend-passes.c | 17 +++++---- gcc/testsuite/ChangeLog | 4 +++ .../gfortran.dg/function_optimize_8.f90 | 36 +++++++++++++++++++ 4 files changed, 54 insertions(+), 9 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/function_optimize_8.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b0f4e92d74d..55994c3140e 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2011-05-22 Thomas Koenig + + * frontend-passes.c (cfe_register_funcs): Also register + character functions if their charlens are known and constant. + Also register allocatable functions. + 2011-05-21 Janus Weil PR fortran/48699 diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 186cbb43304..0137a9ddbf2 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -137,8 +137,7 @@ optimize_expr (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, /* Callback function for common function elimination, called from cfe_expr_0. - Put all eligible function expressions into expr_array. We can't do - allocatable functions. */ + Put all eligible function expressions into expr_array. */ static int cfe_register_funcs (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, @@ -148,8 +147,10 @@ cfe_register_funcs (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, if ((*e)->expr_type != EXPR_FUNCTION) return 0; - /* We don't do character functions (yet). */ - if ((*e)->ts.type == BT_CHARACTER) + /* We don't do character functions with unknown charlens. */ + if ((*e)->ts.type == BT_CHARACTER + && ((*e)->ts.u.cl == NULL || (*e)->ts.u.cl->length == NULL + || (*e)->ts.u.cl->length->expr_type != EXPR_CONSTANT)) return 0; /* If we don't know the shape at compile time, we create an allocatable @@ -163,9 +164,6 @@ cfe_register_funcs (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, is specified. */ if ((*e)->value.function.esym) { - if ((*e)->value.function.esym->attr.allocatable) - return 0; - /* Don't create an array temporary for elemental functions. */ if ((*e)->value.function.esym->attr.elemental && (*e)->rank > 0) return 0; @@ -181,9 +179,10 @@ cfe_register_funcs (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, if ((*e)->value.function.isym) { /* Conversions are handled on the fly by the middle end, - transpose during trans-* stages. */ + transpose during trans-* stages and TRANSFER by the middle end. */ if ((*e)->value.function.isym->id == GFC_ISYM_CONVERSION - || (*e)->value.function.isym->id == GFC_ISYM_TRANSPOSE) + || (*e)->value.function.isym->id == GFC_ISYM_TRANSPOSE + || (*e)->value.function.isym->id == GFC_ISYM_TRANSFER) return 0; /* Don't create an array temporary for elemental functions, diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0d937892dd2..74831063f8e 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2011-05-22 Thomas Koenig + + * gfortran.dg/function_optimize_8.f90: New test case. + 2011-05-22 Ira Rosen PR tree-optimization/49087 diff --git a/gcc/testsuite/gfortran.dg/function_optimize_8.f90 b/gcc/testsuite/gfortran.dg/function_optimize_8.f90 new file mode 100644 index 00000000000..c197a6d7ff5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/function_optimize_8.f90 @@ -0,0 +1,36 @@ +! { dg-do compile } +! { dg-options "-O -fdump-tree-original" } +module x + implicit none +contains + pure function myfunc(x) result(y) + integer, intent(in) :: x + integer, dimension(:), allocatable :: y + allocate (y(3)) + y(1) = x + y(2) = 2*x + y(3) = 3*x + end function myfunc + + pure function mychar(x) result(r) + integer, intent(in) :: x + character(len=2) :: r + r = achar(x + iachar('0')) // achar(x + iachar('1')) + end function mychar +end module x + +program main + use x + implicit none + integer :: n + character(len=20) :: line + n = 3 + write (unit=line,fmt='(3I2)') myfunc(n) + myfunc(n) + if (line /= ' 61218') call abort + write (unit=line,fmt='(A)') mychar(2) // mychar(2) + if (line /= '2323') call abort +end program main +! { dg-final { scan-tree-dump-times "myfunc" 2 "original" } } +! { dg-final { scan-tree-dump-times "mychar" 2 "original" } } +! { dg-final { cleanup-tree-dump "original" } } +! { dg-final { cleanup-modules "x" } }