[Patch,Fortran] Do not auto-deallocate result variable

[Tobias Burnus <burnus at net-b dot de>]

Hi all,

this fixes a stupid bug, where gfortran tried to free a result variable.
I do not fully understand why this has not been found earlier as the
code is clearly wrong and the program fails with 4.2, 4.3 and 4.4
with an ICE.

Before the if-block of my patch there is:

  /* Allocatable arrays need to be freed when they go out of scope.
     The allocatable components of pointers must not be touched.  */
  if (sym_has_alloc_comp && !(sym->attr.function || sym->attr.result)
      && !sym->attr.pointer && !sym->attr.save)

where the sym->attr.result case is properly honoured. But five lines
later is was unfortunately missed.

Thanks to Rich Townsend for reporting this bug.

Built and currently check-gfortran'ing on x86-64-linux.
OK for the trunk and 4.3 ?

(Unless there are objections, I plan to commit it as obvious tomorrow.)

Tobias

2008-09-23  Tobias Burnus  <burnus@net-b.de>

	PR fortran/37626
	* trans-array.c (gfc_trans_deferred_array): Don't auto-deallocate
	result variable.

2008-09-23  Tobias Burnus  <burnus@net-b.de>

	PR fortran/37626
	* gfortran.dg/allocatable_function_4.f90: New test.

Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c	(Revision 140615)
+++ gcc/fortran/trans-array.c	(Arbeitskopie)
@@ -5754,7 +5754,7 @@ gfc_trans_deferred_array (gfc_symbol * s
       gfc_add_expr_to_block (&fnblock, tmp);
     }
 
-  if (sym->attr.allocatable && !sym->attr.save)
+  if (sym->attr.allocatable && !sym->attr.save && !sym->attr.result)
     {
       tmp = gfc_trans_dealloc_allocated (sym->backend_decl);
       gfc_add_expr_to_block (&fnblock, tmp);
Index: gcc/testsuite/gfortran.dg/allocatable_function_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/allocatable_function_4.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/allocatable_function_4.f90	(Revision 0)
@@ -0,0 +1,56 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/37626
+! Contributed by Rich Townsend
+!
+! The problem was an ICE when trying to deallocate the
+! result variable "x_unique".
+!
+function unique_A (x, sorted) result (x_unique)
+  implicit none
+  character(*), dimension(:), intent(in)       :: x
+  logical, intent(in), optional                :: sorted
+  character(LEN(x)), dimension(:), allocatable :: x_unique
+
+  logical                                      :: sorted_
+  character(LEN(x)), dimension(SIZE(x))        :: x_sorted
+  integer                                      :: n_x
+  logical, dimension(SIZE(x))                  :: mask
+
+  integer, external                            :: b3ss_index
+
+! Set up sorted_
+
+  if(PRESENT(sorted)) then
+     sorted_ = sorted
+  else
+     sorted_ = .FALSE.
+  endif
+
+! If necessary, sort x
+
+  if(sorted_) then
+     x_sorted = x
+  else
+     x_sorted = x(b3ss_index(x))
+  endif
+
+! Set up the unique array
+
+  n_x = SIZE(x)
+
+  mask = (/.TRUE.,x_sorted(2:n_x) /= x_sorted(1:n_x-1)/)
+
+  allocate(x_unique(COUNT(mask)))
+
+  x_unique = PACK(x_sorted, MASK=mask)
+
+! Finish
+
+  return
+end function unique_A
+
+! { dg-final { scan-tree-dump-times "__builtin_free" 5 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+