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:
parent
2d8c9ad5c9
commit
222c2a6395
@ -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
|
||||
|
@ -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;
|
||||
|
@ -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.
|
||||
|
46
gcc/testsuite/gfortran.dg/function_optimize_7.f90
Normal file
46
gcc/testsuite/gfortran.dg/function_optimize_7.f90
Normal 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" } }
|
Loading…
Reference in New Issue
Block a user