From 5b0b72518b76d75ad93ac95e6e05e772124085df Mon Sep 17 00:00:00 2001
From: Erik Edelmann <eedelman@gcc.gnu.org>
Date: Sun, 12 Feb 2006 17:34:15 +0000
Subject: [PATCH] re PR fortran/25806 (problems with functions returning array
pointers?)
fortran/
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.
testsuite/
2006-02-12 Erik Edelmann <eedelman@gcc.gnu.org>
PR fortran/25806
* gfortran.dg/ret_pointer_2.f90: New test.
From-SVN: r110893
---
gcc/fortran/ChangeLog | 17 +++++++++
gcc/fortran/trans-array.c | 27 ++++++++-------
gcc/fortran/trans-array.h | 3 +-
gcc/fortran/trans-expr.c | 12 +++++--
gcc/testsuite/ChangeLog | 5 +++
gcc/testsuite/gfortran.dg/ret_pointer_2.f90 | 38 +++++++++++++++++++++
6 files changed, 86 insertions(+), 16 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/ret_pointer_2.f90
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ca341442f689..8551a74a91f3 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,20 @@
+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
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 1edc7b79f6f0..5e8238b67632 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -479,9 +479,9 @@ gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping * mapping,
/* 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
@@ -489,8 +489,8 @@ gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping * mapping,
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;
@@ -546,7 +546,7 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post,
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);
@@ -565,12 +565,13 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post,
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;
@@ -665,7 +666,8 @@ gfc_trans_allocate_temp_array (stmtblock_t * pre, stmtblock_t * post,
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;
@@ -1416,7 +1418,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss)
}
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;
@@ -2832,7 +2834,8 @@ gfc_conv_loop_setup (gfc_loopinfo * loop)
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++)
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index ef3d0265187b..2f9fd2d74ffd 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -32,7 +32,8 @@ void gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping *,
/* Generate code to allocate a temporary array. */
tree gfc_trans_allocate_temp_array (stmtblock_t *, stmtblock_t *,
- gfc_loopinfo *, gfc_ss_info *, tree, bool);
+ gfc_loopinfo *, gfc_ss_info *, tree, 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 d64dabe491fc..3fbbf0e09e37 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1953,9 +1953,11 @@ 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. */
- 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]);
@@ -2913,6 +2915,10 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
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
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index be9824e030c1..845090db732d 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2006-02-12 Erik Edelmann <eedelman@gcc.gnu.org>
+
+ PR fortran/25806
+ * gfortran.dg/ret_pointer_2.f90: New test.
+
2006-02-10 Zdenek Dvorak <dvorakz@suse.cz>
* gcc.dg/20050105-1.c: Do not use -floop-optimize2.
diff --git a/gcc/testsuite/gfortran.dg/ret_pointer_2.f90 b/gcc/testsuite/gfortran.dg/ret_pointer_2.f90
new file mode 100644
index 000000000000..939411b7bc22
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ret_pointer_2.f90
@@ -0,0 +1,38 @@
+! { 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
+
+
--
GitLab