re PR fortran/22572 (Double occurrence of matmul intrinsic not optimised)

2011-05-14  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/22572
	* frontend-passes.c (cfe_register_funcs):  Also register functions
	for potential elimination if the rank is > 0, the shape is unknown
	and reallocate on assignment is active.
	(create_var):  For rank > 0 functions with unknown shape, create
	an allocatable temporary.

2011-05-14  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/22572
	* function_optimize_7.f90:  New test case.

From-SVN: r173752
This commit is contained in:
Thomas Koenig 2011-05-14 09:48:08 +00:00
parent 2d8c9ad5c9
commit 222c2a6395
4 changed files with 94 additions and 18 deletions

View File

@ -1,3 +1,12 @@
2011-05-14 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/22572
* frontend-passes.c (cfe_register_funcs): Also register functions
for potential elimination if the rank is > 0, the shape is unknown
and reallocate on assignment is active.
(create_var): For rank > 0 functions with unknown shape, create
an allocatable temporary.
2011-05-14 Tobias Burnus <burnus@net-b.de>
* options.c (gfc_init_options, gfc_post_options): Enable

View File

@ -152,11 +152,11 @@ cfe_register_funcs (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
if ((*e)->ts.type == BT_CHARACTER)
return 0;
/* If we don't know the shape at compile time, we do not create a temporary
variable to hold the intermediate result. FIXME: Change this later when
allocation on assignment works for intrinsics. */
/* If we don't know the shape at compile time, we create an allocatable
temporary variable to hold the intermediate result, but only if
allocation on assignment is active. */
if ((*e)->rank > 0 && (*e)->shape == NULL)
if ((*e)->rank > 0 && (*e)->shape == NULL && !gfc_option.flag_realloc_lhs)
return 0;
/* Skip the test for pure functions if -faggressive-function-elimination
@ -250,22 +250,38 @@ create_var (gfc_expr * e)
symbol = symtree->n.sym;
symbol->ts = e->ts;
symbol->as = gfc_get_array_spec ();
symbol->as->rank = e->rank;
symbol->as->type = AS_EXPLICIT;
for (i=0; i<e->rank; i++)
if (e->rank > 0)
{
gfc_expr *p, *q;
symbol->as = gfc_get_array_spec ();
symbol->as->rank = e->rank;
if (e->shape == NULL)
{
/* We don't know the shape at compile time, so we use an
allocatable. */
symbol->as->type = AS_DEFERRED;
symbol->attr.allocatable = 1;
}
else
{
symbol->as->type = AS_EXPLICIT;
/* Copy the shape. */
for (i=0; i<e->rank; i++)
{
gfc_expr *p, *q;
p = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind,
&(e->where));
mpz_set_si (p->value.integer, 1);
symbol->as->lower[i] = p;
q = gfc_get_constant_expr (BT_INTEGER, gfc_index_integer_kind,
&(e->where));
mpz_set (q->value.integer, e->shape[i]);
symbol->as->upper[i] = q;
p = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind,
&(e->where));
mpz_set_si (p->value.integer, 1);
symbol->as->lower[i] = p;
q = gfc_get_constant_expr (BT_INTEGER, gfc_index_integer_kind,
&(e->where));
mpz_set (q->value.integer, e->shape[i]);
symbol->as->upper[i] = q;
}
}
}
symbol->attr.flavor = FL_VARIABLE;

View File

@ -1,3 +1,8 @@
2011-05-14 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/22572
* function_optimize_7.f90: New test case.
2011-05-13 Jason Merrill <jason@redhat.com>
* g++.dg/cpp0x/decltype26.C: New.

View File

@ -0,0 +1,46 @@
! { dg-do compile }
! { dg-options "-O -fdump-tree-original -Warray-temporaries" }
subroutine xx(n, m, a, b, c, d, x, z, i, s_in, s_out)
implicit none
integer, intent(in) :: n, m
real, intent(in), dimension(n,n) :: a, b, c
real, intent(out), dimension(n,n) :: d
real, intent(in), dimension(n,m) :: s_in
real, intent(out), dimension(m) :: s_out
integer, intent(out) :: i
real, intent(inout) :: x
real, intent(out) :: z
character(60) :: line
real, external :: ext_func
interface
elemental function element(x)
real, intent(in) :: x
real :: elem
end function element
pure function mypure(x)
real, intent(in) :: x
integer :: mypure
end function mypure
elemental impure function elem_impure(x)
real, intent(in) :: x
real :: elem_impure
end function elem_impure
end interface
d = matmul(a,b) + matmul(a,b) ! { dg-warning "Creating array temporary" }
z = sin(x) + cos(x) + sin(x) + cos(x)
x = ext_func(a) + 23 + ext_func(a)
z = element(x) + element(x)
i = mypure(x) - mypure(x)
z = elem_impure(x) - elem_impure(x)
s_out = sum(s_in,1) + 3.14 / sum(s_in,1) ! { dg-warning "Creating array temporary" }
end subroutine xx
! { dg-final { scan-tree-dump-times "matmul_r4" 1 "original" } }
! { dg-final { scan-tree-dump-times "__builtin_sinf" 1 "original" } }
! { dg-final { scan-tree-dump-times "__builtin_cosf" 1 "original" } }
! { dg-final { scan-tree-dump-times "ext_func" 2 "original" } }
! { dg-final { scan-tree-dump-times "element" 1 "original" } }
! { dg-final { scan-tree-dump-times "mypure" 1 "original" } }
! { dg-final { scan-tree-dump-times "elem_impure" 2 "original" } }
! { dg-final { scan-tree-dump-times "sum_r4" 1 "original" } }
! { dg-final { cleanup-tree-dump "original" } }