symbol.c (check_conflict): Allow allocatable function results, except for elemental functions.

fortran/
2006-03-11  Erik Edelmann  <eedelman@gcc.gnu.org>

        * symbol.c (check_conflict): Allow allocatable function results,
        except for elemental functions.
        * trans-array.c (gfc_trans_allocate_temp_array): Rename to ...
        (gfc_trans_create_temp_array): ... this, and add new argument callee_alloc.
        (gfc_trans_array_constructor, gfc_conv_loop_setup): Update call
        to gfc_trans_allocate_temp_array.
        * trans-array.h (gfc_trans_allocate_temp_array): Update prototype.
        * trans-expr.c (gfc_conv_function_call): Use new arg of
        gfc_trans_create_temp_array avoid pre-allocation of temporary
        result variables of pointer AND allocatable functions.
        (gfc_trans_arrayfunc_assign): Return NULL for allocatable functions.
        * resolve.c (resolve_symbol): Copy value of 'allocatable' attribute
        from sym->result to sym.

testsuite/
2006-03-08  Paul Thomas  <pault@gcc.gnu.org>
            Erik Edelmann  <eedelman@gcc.gnu.org>

        * gfortran.dg/allocatable_function_1.f90: New.
        * gfortran.dg/allocatable_function_2.f90: New.

From-SVN: r111951

10 files changed, 193 insertions, 27 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2e3d0f2..0f0f049 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,21 @@
+2006-03-11  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	* symbol.c (check_conflict): Allow allocatable function results,
+	  except for elemental functions.
+	* trans-array.c (gfc_trans_allocate_temp_array): Rename to ...
+	  (gfc_trans_create_temp_array): ... this, and add new argument
+	  callee_alloc.
+	  (gfc_trans_array_constructor, gfc_conv_loop_setup): Update call
+	  to gfc_trans_allocate_temp_array.
+	* trans-array.h (gfc_trans_allocate_temp_array): Update prototype.
+	* trans-expr.c (gfc_conv_function_call): Use new arg of
+	  gfc_trans_create_temp_array avoid pre-allocation of temporary
+	  result variables of pointer AND allocatable functions.
+	  (gfc_trans_arrayfunc_assign): Return NULL for allocatable
+	  functions.
+	* resolve.c (resolve_symbol): Copy value of 'allocatable' attribute
+	  from sym->result to sym.
+
 2006-03-09  Erik Edelmann  <eedelman@gcc.gnu.org>
 
 	* trans-expr.c (gfc_add_interface_mapping): Copy 'allocatable'
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 7696962..89c7770 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -1332,8 +1332,16 @@ Support for the declaration of enumeration constants via the
 @command{-fshort-enums} command line option is given.
 
 @item
+@cindex TR 15581
+The following parts of TR 15581:
+@itemize
+@item
 @cindex @code{ALLOCATABLE} dummy arguments
 The @code{ALLOCATABLE} attribute for dummy arguments.
+@item
+@cindex @code{ALLOCATABLE} function results
+@code{ALLOCATABLE} function results
+@end itemize
 
 @end itemize
 
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 3e7eb9d..548b67e 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5152,6 +5152,7 @@ resolve_symbol (gfc_symbol * sym)
 	      sym->as = gfc_copy_array_spec (sym->result->as);
 	      sym->attr.dimension = sym->result->attr.dimension;
 	      sym->attr.pointer = sym->result->attr.pointer;
+	      sym->attr.allocatable = sym->result->attr.allocatable;
 	    }
 	}
     }
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index e98556d..bd7ad1c 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -322,6 +322,7 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
   conf (pointer, external);
   conf (pointer, intrinsic);
   conf (pointer, elemental);
+  conf (allocatable, elemental);
 
   conf (target, external);
   conf (target, intrinsic);
@@ -337,8 +338,8 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
 
   conf (allocatable, pointer);
   conf_std (allocatable, dummy, GFC_STD_F2003);
-  conf (allocatable, function);	/* TODO: Allowed in Fortran 200x.  */
-  conf (allocatable, result);	/* TODO: Allowed in Fortran 200x.  */
+  conf_std (allocatable, function, GFC_STD_F2003);
+  conf_std (allocatable, result, GFC_STD_F2003);
   conf (elemental, recursive);
 
   conf (in_common, dummy);
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index a865d57..15f49b5 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -558,20 +558,24 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post,
 }
 
 
-/* Generate code to allocate and initialize the descriptor for a temporary
+/* Generate code to create and initialize the descriptor for a temporary
    array.  This is used for both temporaries needed by the scalarizer, and
-   functions returning arrays.  Adjusts the loop variables to be zero-based,
-   and calculates the loop bounds for callee allocated arrays.
-   Also fills in the descriptor, data and offset fields of info if known.
-   Returns the size of the array, or NULL for a callee allocated array.
+   functions returning arrays.  Adjusts the loop variables to be
+   zero-based, and calculates the loop bounds for callee allocated arrays.
+   Allocate the array unless it's callee allocated (we have a callee
+   allocated array if 'callee_alloc' is true, or if loop->to[n] is
+   NULL_TREE for any n).  Also fills in the descriptor, data and offset
+   fields of info if known.  Returns the size of the array, or NULL for a
+   callee allocated array.
 
    PRE, POST, DYNAMIC and DEALLOC are as for gfc_trans_allocate_array_storage.
  */
 
 tree
-gfc_trans_allocate_temp_array (stmtblock_t * pre, stmtblock_t * post,
-                               gfc_loopinfo * loop, gfc_ss_info * info,
-                               tree eltype, bool dynamic, bool dealloc)
+gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
+			     gfc_loopinfo * loop, gfc_ss_info * info,
+			     tree eltype, bool dynamic, bool dealloc,
+			     bool callee_alloc)
 {
   tree type;
   tree desc;
@@ -662,12 +666,14 @@ gfc_trans_allocate_temp_array (stmtblock_t * pre, stmtblock_t * post,
 
   /* Get the size of the array.  */
   nelem = size;
-  if (size)
+  if (size && !callee_alloc)
     size = fold_build2 (MULT_EXPR, gfc_array_index_type, size,
 			TYPE_SIZE_UNIT (gfc_get_element_type (type)));
+  else
+    size = NULL_TREE;
 
   gfc_trans_allocate_array_storage (pre, post, info, size, nelem, dynamic,
-                                    dealloc);
+			            dealloc);
 
   if (info->dimen > loop->temp_dim)
     loop->temp_dim = info->dimen;
@@ -1417,8 +1423,8 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss)
       mpz_clear (size);
     }
 
-  gfc_trans_allocate_temp_array (&loop->pre, &loop->post, loop,
-                                 &ss->data.info, type, dynamic, true);
+  gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, &ss->data.info,
+			       type, dynamic, true, false);
 
   desc = ss->data.info.descriptor;
   offset = gfc_index_zero_node;
@@ -2834,9 +2840,9 @@ gfc_conv_loop_setup (gfc_loopinfo * loop)
       memset (&loop->temp_ss->data.info, 0, sizeof (gfc_ss_info));
       loop->temp_ss->type = GFC_SS_SECTION;
       loop->temp_ss->data.info.dimen = n;
-      gfc_trans_allocate_temp_array (&loop->pre, &loop->post, loop,
-                                     &loop->temp_ss->data.info, tmp, false,
-                                     true);
+      gfc_trans_create_temp_array (&loop->pre, &loop->post, loop,
+				   &loop->temp_ss->data.info, tmp, false, true,
+				   false);
     }
 
   for (n = 0; n < loop->temp_dim; n++)
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index fed1bf0..bc7cab5 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -30,10 +30,9 @@ bool gfc_array_allocate (gfc_se *, gfc_expr *, tree);
 void gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping *,
 					  gfc_se *, gfc_array_spec *);
 
-/* Generate code to allocate a temporary array.  */
-tree gfc_trans_allocate_temp_array (stmtblock_t *, stmtblock_t *,
-                                    gfc_loopinfo *, gfc_ss_info *, tree, bool,
-                                    bool);
+/* Generate code to create a temporary array.  */
+tree gfc_trans_create_temp_array (stmtblock_t *, stmtblock_t *, gfc_loopinfo *,
+                                  gfc_ss_info *, tree, bool, bool, bool);
 
 /* Generate function entry code for allocation of compiler allocated array
    variables.  */
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index d1570a7..890b880 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1805,6 +1805,7 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
   gfc_formal_arglist *formal;
   int has_alternate_specifier = 0;
   bool need_interface_mapping;
+  bool callee_alloc;
   gfc_typespec ts;
   gfc_charlen cl;
 
@@ -1992,11 +1993,12 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
 	  /* Evaluate the bounds of the result, if known.  */
 	  gfc_set_loop_bounds_from_array_spec (&mapping, se, sym->result->as);
 
-	  /* Allocate a temporary to store the result.  In case the function
-             returns a pointer, the temporary will be a shallow copy and
-             mustn't be deallocated.  */
-          gfc_trans_allocate_temp_array (&se->pre, &se->post, se->loop, info,
-                                         tmp, false, !sym->attr.pointer);
+	  /* Create a temporary to store the result.  In case the function
+	     returns a pointer, the temporary will be a shallow copy and
+	     mustn't be deallocated.  */
+	  callee_alloc = sym->attr.allocatable || sym->attr.pointer;
+	  gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, info, tmp,
+				       false, !sym->attr.pointer, callee_alloc);
 
 	  /* Zero the first stride to indicate a temporary.  */
 	  tmp = gfc_conv_descriptor_stride (info->descriptor, gfc_rank_cst[0]);
@@ -2955,7 +2957,8 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
     return NULL;
 
   /* Functions returning pointers need temporaries.  */
-  if (expr2->symtree->n.sym->attr.pointer)
+  if (expr2->symtree->n.sym->attr.pointer 
+      || expr2->symtree->n.sym->attr.allocatable)
     return NULL;
 
   /* Check that no LHS component references appear during an array
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 4c47054..92724b0 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2006-03-11  Paul Thomas  <pault@gcc.gnu.org>
+	    Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	* gfortran.dg/allocatable_function_1.f90: New.
+	* gfortran.dg/allocatable_function_2.f90: New.
+
 2006-03-10  Richard Guenther  <rguenther@suse.de>
 
 	PR middle-end/26565
diff --git a/gcc/testsuite/gfortran.dg/allocatable_function_1.f90 b/gcc/testsuite/gfortran.dg/allocatable_function_1.f90
new file mode 100644
index 0000000..b66d6ae
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocatable_function_1.f90
@@ -0,0 +1,112 @@
+! { dg-do run }
+! { dg-options "-O2 -fdump-tree-original" }
+! Test ALLOCATABLE functions; the primary purpose here is to check that
+! each of the various types of reference result in the function result
+! being deallocated, using _gfortran_internal_free.
+! The companion, allocatable_function_1r.f90, executes this program.
+!
+subroutine moobar (a)
+    integer, intent(in) :: a(:)
+
+    if (.not.all(a == [ 1, 2, 3 ])) call abort()
+end subroutine moobar
+
+function foo2 (n)
+    integer, intent(in) :: n
+    integer, allocatable :: foo2(:)
+    integer :: i
+    allocate (foo2(n))
+    do i = 1, n
+        foo2(i) = i
+    end do
+end function foo2
+
+module m
+contains
+    function foo3 (n)
+        integer, intent(in) :: n
+        integer, allocatable :: foo3(:)
+        integer :: i
+        allocate (foo3(n))
+        do i = 1, n
+            foo3(i) = i
+        end do
+    end function foo3
+end module m
+
+program alloc_fun
+
+    use m
+    implicit none
+
+    integer :: a(3)
+
+    interface
+      subroutine moobar (a)
+          integer, intent(in) :: a(:)
+      end subroutine moobar
+    end interface
+
+    interface
+        function foo2 (n)
+            integer, intent(in) :: n
+            integer, allocatable :: foo2(:)
+        end function foo2
+    end interface
+
+! 2 _gfortran_internal_free's
+    if (.not.all(foo1(3) == [ 1, 2, 3 ])) call abort()
+    a = foo1(size(a))
+
+! 1 _gfortran_internal_free
+    if (.not.all(a == [ 1, 2, 3 ])) call abort()
+    call foobar(foo1(3))
+
+! 1 _gfortran_internal_free
+    if (.not.all(2*bar(size(a)) + 5 == [ 7, 9, 11 ])) call abort()
+
+! The first reference never happens because the rhs determines the loop size.
+! Thus there is no subsequent _gfortran_internal_free.
+! 2 _gfortran_internal_free's
+    a(1:size (bar (3))) = 2*bar(size(a)) + 2 + a(size (bar (3)))
+    if (.not.all(a == [ 7, 9, 11 ])) call abort()
+
+! 3 _gfortran_internal_free's
+    call moobar(foo1(3))   ! internal function
+    call moobar(foo2(3))   ! module function
+    call moobar(foo3(3))   ! explicit interface
+
+! 9 _gfortran_internal_free's in total
+contains
+
+    subroutine foobar (a)
+        integer, intent(in) :: a(:)
+
+        if (.not.all(a == [ 1, 2, 3 ])) call abort()
+    end subroutine foobar
+
+    function foo1 (n)
+        integer, intent(in) :: n
+        integer, allocatable :: foo1(:)
+        integer :: i
+        allocate (foo1(n))
+        do i = 1, n
+            foo1(i) = i
+        end do
+    end function foo1
+
+    function bar (n) result(b)
+        integer, intent(in) :: n
+        integer, target, allocatable :: b(:)
+        integer :: i
+
+        allocate (b(n))
+        do i = 1, n
+            b(i) = i
+        end do
+    end function bar
+
+end program alloc_fun
+! { dg-final { scan-tree-dump-times "free" 9 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+
diff --git a/gcc/testsuite/gfortran.dg/allocatable_function_2.f90 b/gcc/testsuite/gfortran.dg/allocatable_function_2.f90
new file mode 100644
index 0000000..ab26c2a0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocatable_function_2.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! Test constraints on ALLOCATABLE functions
+program alloc_fun
+
+contains
+
+    elemental function foo (n)
+        integer, intent(in) :: n
+        integer, allocatable :: foo(:) ! { dg-error "ALLOCATABLE .* ELEMENTAL" }
+    end function foo
+
+end program alloc_fun