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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@110893 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ca34144..8551a74 100644 (file)
--- 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 1edc7b7..5e8238b 100644 (file)
--- 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 ef3d026..2f9fd2d 100644 (file)
--- 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 d64dabe..3fbbf0e 100644 (file)
--- 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 be9824e..845090d 100644 (file)
--- 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 (file)
index 0000000..939411b
--- /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
+
+