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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@111951
138bc75d-0d04-0410-961f-
82ee72b054a4
+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'
@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
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;
}
}
}
conf (pointer, external);
conf (pointer, intrinsic);
conf (pointer, elemental);
+ conf (allocatable, elemental);
conf (target, external);
conf (target, intrinsic);
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);
}
-/* 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;
/* 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;
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;
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++)
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. */
gfc_formal_arglist *formal;
int has_alternate_specifier = 0;
bool need_interface_mapping;
+ bool callee_alloc;
gfc_typespec ts;
gfc_charlen cl;
/* 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]);
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
+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
--- /dev/null
+! { 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" } }
+
--- /dev/null
+! { 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
OSDN Git Service
