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

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

gcc/fortran/ChangeLog

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

gcc/fortran/frontend-passes.c

@@ -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
+   Put all eligible function expressions into expr_array.  */
-   allocatable functions.  */
 
 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).  */
+  /* We don't do character functions with unknown charlens.  */
-  if ((*e)->ts.type == BT_CHARACTER)
+  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,

gcc/testsuite/ChangeLog

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

gcc/testsuite/gfortran.dg/function_optimize_8.f90

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