[patch, fortran] Allocatable function results.
Erik Edelmann
erik.edelmann@iki.fi
Wed Mar 8 23:06:00 GMT 2006
:ADDPATCH:
Here's a patch to implement allocatable function results. It
does the following:
* Allow FUNCTION + ALLOCTABALE and RESULT + ALLOCATABLE
attribute combinations for F2003 in symbol.c (check_conflict),
but disallow ALLOCATABLE + ELEMENTAL.
* Copy the value of the 'allocatable' attribute
from sym->result to sym in resolve.c (resolve_symbol).
* Return NULL from trans-expr.c (gfc_trans_arrayfunc_assign) for
allocatable functions to force use of temporary.
* That temporary mustn't be pre-allocated. Therefore, add a new
argument 'bool callee_alloc' for trans-array.c
(gfc_trans_allocate_temp_array), used to tell the function that
the temporary created is callee allocated.
Since code to allocate the temporaries isn't generated by
gfc_trans_allocate_temp_array() for all cases (wasn't before
this change either), I decided that
gfc_trans_create_temp_array() would be a more appropriate name,
so I renamed it.
Use the new capability to avoid pre-allocations in
gfc_trans_create_temp_array() for allocatable function results
in trans-expr.c (gfc_conv_function_call). And in addition I
realized that we should do this for pointer functions as well
(since a pointer can be allocated even when it's associated, it
works without this change, but wastes memory.)
* What did I forget this time :-) ?
Tested on trunk, on Linux/x86. Ok to commit?
Erik
fortran/
2006-03-08 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. Update all callers.
* 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 Erik Edelmann <eedelman@gcc.gnu.org>
* gfortran.dg/allocatable_function_1.f90: New.
* gfortran.dg/allocatable_function_2.f90: New.
-------------- next part --------------
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (revision 111842)
+++ gcc/fortran/trans-expr.c (working copy)
@@ -1803,6 +1803,7 @@ gfc_conv_function_call (gfc_se * se, gfc
gfc_formal_arglist *formal;
int has_alternate_specifier = 0;
bool need_interface_mapping;
+ bool callee_alloc;
gfc_typespec ts;
gfc_charlen cl;
@@ -1990,11 +1991,12 @@ gfc_conv_function_call (gfc_se * se, gfc
/* 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
+ /* 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. */
- gfc_trans_allocate_temp_array (&se->pre, &se->post, se->loop, info,
- tmp, false, !sym->attr.pointer);
+ 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]);
@@ -2953,7 +2955,8 @@ gfc_trans_arrayfunc_assign (gfc_expr * e
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
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c (revision 111842)
+++ gcc/fortran/trans-array.c (working copy)
@@ -558,20 +558,24 @@ gfc_trans_allocate_array_storage (stmtbl
}
-/* 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,9 +666,11 @@ gfc_trans_allocate_temp_array (stmtblock
/* 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);
@@ -1417,8 +1423,8 @@ gfc_trans_array_constructor (gfc_loopinf
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++)
Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c (revision 111842)
+++ gcc/fortran/symbol.c (working copy)
@@ -322,6 +322,7 @@ check_conflict (symbol_attribute * attr,
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,
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);
Index: gcc/fortran/trans-array.h
===================================================================
--- gcc/fortran/trans-array.h (revision 111842)
+++ gcc/fortran/trans-array.h (working copy)
@@ -30,10 +30,9 @@ bool gfc_array_allocate (gfc_se *, gfc_e
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. */
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (revision 111842)
+++ gcc/fortran/resolve.c (working copy)
@@ -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;
}
}
}
-------------- next part --------------
! { dg-do run }
! Test ALLOCATABLE functions
program alloc_fun
implicit none
integer :: a(3)
if (.not.all(foo(3) == [ 1, 2, 3 ])) call abort()
a = foo(size(a))
if (.not.all(a == [ 1, 2, 3 ])) call abort()
call foobar(foo(3))
if (.not.all(2*bar(size(a)) + 5 == [ 7, 9, 11 ])) call abort()
contains
subroutine foobar (a)
integer, intent(in) :: a(:)
if (.not.all(a == [ 1, 2, 3 ])) call abort()
end subroutine foobar
function foo (n)
integer, intent(in) :: n
integer, allocatable :: foo(:)
integer :: i
allocate (foo(n))
do i = 1, n
foo(i) = i
end do
end function foo
function bar (n) result(b)
integer, intent(in) :: n
integer, allocatable :: b(:)
integer :: i
allocate (b(n))
do i = 1, n
b(i) = i
end do
end function bar
end program alloc_fun
-------------- next part --------------
! { 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
More information about the Fortran
mailing list