OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
This commit is contained in:
Erik Edelmann 2006-03-10 23:28:38 +00:00
parent ea725d4524
commit 8e119f1b63
10 changed files with 193 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
gcc/fortran/ChangeLog
View File

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

8
gcc/fortran/gfortran.texi
View File

@ -1331,9 +1331,17 @@ Support for the declaration of enumeration constants via the
@command{gcc} is guaranteed also for the case where 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

1
gcc/fortran/resolve.c
View File

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

5
gcc/fortran/symbol.c
View File

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

36
gcc/fortran/trans-array.c
View File

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

7
gcc/fortran/trans-array.h
View File

@ -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. */

15
gcc/fortran/trans-expr.c
View File

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

6
gcc/testsuite/ChangeLog
View File

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

112
gcc/testsuite/gfortran.dg/allocatable_function_1.f90 Normal file
View File

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

12
gcc/testsuite/gfortran.dg/allocatable_function_2.f90 Normal file
View File

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