From: Thomas Koenig Date: Sat, 14 May 2011 09:48:08 +0000 (+0000) Subject: re PR fortran/22572 (Double occurrence of matmul intrinsic not optimised) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=222c2a639505176798bb60e9a07b88ee90451c2a;p=gcc.git re PR fortran/22572 (Double occurrence of matmul intrinsic not optimised) 2011-05-14 Thomas Koenig 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 PR fortran/22572 * function_optimize_7.f90: New test case. From-SVN: r173752 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b4168316436..8e2ec731c81 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2011-05-14 Thomas Koenig + + 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 * options.c (gfc_init_options, gfc_post_options): Enable diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 85af45eec6f..186cbb43304 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -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; irank; 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; irank; 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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 1f20a8f13c1..6cbf8829f95 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2011-05-14 Thomas Koenig + + PR fortran/22572 + * function_optimize_7.f90: New test case. + 2011-05-13 Jason Merrill * g++.dg/cpp0x/decltype26.C: New. diff --git a/gcc/testsuite/gfortran.dg/function_optimize_7.f90 b/gcc/testsuite/gfortran.dg/function_optimize_7.f90 new file mode 100644 index 00000000000..212c8fbd491 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/function_optimize_7.f90 @@ -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" } }