OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

frontend-passes.c (cfe_register_funcs): Also register character functions if their charlens are known and constant.

Browse Source 
2011-05-22  Thomas Koenig  <tkoenig@gcc.gnu.org>

	* 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  <tkoenig@gcc.gnu.org>

	* gfortran.dg/function_optimize_8.f90:  New test case.

From-SVN: r174027
This commit is contained in:
Thomas Koenig 2011-05-22 10:38:09 +00:00
parent e38fdc948a
commit 42a2717cb7
4 changed files with 54 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
2011-05-22 Thomas Koenig <tkoenig@gcc.gnu.org>
* 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 <janus@gcc.gnu.org>
PR fortran/48699

17
gcc/fortran/frontend-passes.c
View File

@ -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,

4
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,7 @@
2011-05-22 Thomas Koenig <tkoenig@gcc.gnu.org>
* gfortran.dg/function_optimize_8.f90: New test case.
2011-05-22 Ira Rosen <ira.rosen@linaro.org>
PR tree-optimization/49087

36
gcc/testsuite/gfortran.dg/function_optimize_8.f90 Normal file
View File

@ -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" } }