+2006-02-12 Erik Edelmann <eedelman@gcc.gnu.org>
+
+ PR fortran/25806
+ * trans-array.c (gfc_trans_allocate_array_storage): New argument
+ dealloc; free the temporary only if dealloc is true.
+ (gfc_trans_allocate_temp_array): New argument bool dealloc, to be
+ passed onwards to gfc_trans_allocate_array_storage.
+ (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 function
+ prototype.
+ * trans-expr.c (gfc_conv_function_call): Set new argument 'dealloc'
+ to gfc_trans_allocate_temp_array to false in case of functions
+ returning pointers.
+ (gfc_trans_arrayfunc_assign): Return NULL for functions returning
+ pointers.
+
2006-02-10 Steven G. Kargl <kargls@comcast.net>
PR fortran/20858
/* Generate code to allocate an array temporary, or create a variable to
- hold the data. If size is NULL zero the descriptor so that so that the
- callee will allocate the array. Also generates code to free the array
- afterwards.
+ hold the data. If size is NULL, zero the descriptor so that the
+ callee will allocate the array. If DEALLOC is true, also generate code to
+ free the array afterwards.
Initialization code is added to PRE and finalization code to POST.
DYNAMIC is true if the caller may want to extend the array later
static void
gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post,
- gfc_ss_info * info, tree size, tree nelem,
- bool dynamic)
+ gfc_ss_info * info, tree size, tree nelem,
+ bool dynamic, bool dealloc)
{
tree tmp;
tree args;
tmp = gfc_conv_descriptor_offset (desc);
gfc_add_modify_expr (pre, tmp, gfc_index_zero_node);
- if (!onstack)
+ if (dealloc && !onstack)
{
/* Free the temporary. */
tmp = gfc_conv_descriptor_data_get (desc);
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 and DYNAMIC are as for gfc_trans_allocate_array_storage. */
+ 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)
+ gfc_loopinfo * loop, gfc_ss_info * info,
+ tree eltype, bool dynamic, bool dealloc)
{
tree type;
tree desc;
size = fold_build2 (MULT_EXPR, gfc_array_index_type, size,
TYPE_SIZE_UNIT (gfc_get_element_type (type)));
- gfc_trans_allocate_array_storage (pre, post, info, size, nelem, dynamic);
+ gfc_trans_allocate_array_storage (pre, post, info, size, nelem, dynamic,
+ dealloc);
if (info->dimen > loop->temp_dim)
loop->temp_dim = info->dimen;
}
gfc_trans_allocate_temp_array (&loop->pre, &loop->post, loop,
- &ss->data.info, type, dynamic);
+ &ss->data.info, type, dynamic, true);
desc = ss->data.info.descriptor;
offset = gfc_index_zero_node;
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);
+ &loop->temp_ss->data.info, tmp, false,
+ true);
}
for (n = 0; n < loop->temp_dim; n++)
/* 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. */
- gfc_trans_allocate_temp_array (&se->pre, &se->post,
- se->loop, info, tmp, false);
+ /* 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);
/* Zero the first stride to indicate a temporary. */
tmp = gfc_conv_descriptor_stride (info->descriptor, gfc_rank_cst[0]);
if (gfc_ref_needs_temporary_p (expr1->ref))
return NULL;
+ /* Functions returning pointers need temporaries. */
+ if (expr2->symtree->n.sym->attr.pointer)
+ return NULL;
+
/* Check that no LHS component references appear during an array
reference. This is needed because we do not have the means to
span any arbitrary stride with an array descriptor. This check
--- /dev/null
+! { dg-do run }
+! PR 25806: Functions returning pointers to arrays
+program a
+ integer, target :: storage(5)
+ integer :: s(3)
+
+
+ print *, x(3) ! { dg-output " *1 *2 *3" }
+
+ if (ssum(x(3)) /= 6) call abort()
+
+ s = 0
+ s = x(3)
+ if (any(s /= (/1, 2, 3/))) call abort()
+
+contains
+
+ function x(n) result(t)
+ integer, intent(in) :: n
+ integer, pointer :: t(:)
+ integer :: i
+
+ t => storage(1:n)
+ t = (/ (i, i = 1, n) /)
+
+ end function x
+
+
+ integer function ssum(a)
+ integer, intent(in) :: a(:)
+
+ ssum = sum(a)
+
+ end function ssum
+
+end program a
+
+