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 ca341442f689a73056d54eee676e84b8d87a5295..8551a74a91f3faf98f30977743633451ab7e55c0 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 1edc7b79f6f07550ed8306adba60029ca577dd01..5e8238b67632b75d393c223f6e69498c6b8e74e1 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 ef3d0265187b08e0d0f0a72bd25d86fd7766a8df..2f9fd2d74ffd5884b12a4b72202835c20d79f4f8 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 d64dabe491fcc0ecdbf7dbcae62fe07b4a9f9b1c..3fbbf0e09e372ce4a02884a14f63c0429c036b9a 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 be9824e030c1f041158777ee7eeeb20e895952c0..845090db732d17fb503b508f294927cb63d67adc 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
+
+