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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b4168316436bf7b06a0c42006ef313527a00cc2d..8e2ec731c81f525ff2f328a68cb6a3e0a6d3a6e9 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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

diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index 85af45eec6f6ea2c6be2f8b84412e27535a2c48a..186cbb433042e3c717b77d45b4c03e1a6d7e8c9d 100644 (file)
--- 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; 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;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 1f20a8f13c15d37062cc70f2aed7ef2cfc616ced..6cbf8829f9533d562e7ca7d444da4e0d7b6c697d 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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.

diff --git a/gcc/testsuite/gfortran.dg/function_optimize_7.f90 b/gcc/testsuite/gfortran.dg/function_optimize_7.f90
new file mode 100644 (file)
index 0000000..212c8fb
--- /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" } }