re PR fortran/40440 (Automatic deallocation component of DT function return value)

2009-06-19  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/40440
	* trans-expr.c (gfc_conv_procedure_call): Do not deallocate
	allocatable components if the argument is a pointer.

2009-06-19  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/40440
	* gfortran.dg/alloc_comp_result_2.f90: New test.

From-SVN: r148731

gcc/fortran/ChangeLog

+2009-06-19  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/40440
+	* trans-expr.c (gfc_conv_procedure_call): Do not deallocate
+	allocatable components if the argument is a pointer.
+
 2009-06-19  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
 
 	* gfortran.h (gfc_expr): Use mpc_t to represent complex numbers.

gcc/fortran/trans-expr.c

@@ -2739,6 +2739,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	 dealt with in trans-array.c(gfc_conv_array_parameter).  */
       if (e && e->ts.type == BT_DERIVED
 	    && e->ts.derived->attr.alloc_comp
+	    && !(e->symtree && e->symtree->n.sym->attr.pointer)
 	    && (e->expr_type != EXPR_VARIABLE && !e->rank))
         {
 	  int parm_rank;

gcc/testsuite/ChangeLog

+2009-06-19  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/40440
+	* gfortran.dg/alloc_comp_result_2.f90: New test.
+
 2009-06-19  Ramana Radhakrishnan  <ramana.radhakrishnan@arm.com>
 
 	PR target/40482

gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90

+! { dg-do run }
+! Tests the fix for PR40440, in which gfortran tried to deallocate
+! the allocatable components of the actual argument of CALL SUB
+!
+! Contributed by Juergen Reuter <juergen.reuter@desy.de>
+! Reduced testcase from Tobias Burnus  <burnus@gcc.gnu.org> 
+!
+  implicit none
+  type t
+    integer, allocatable :: A(:)
+  end type t
+  type (t) :: arg
+  arg = t ([1,2,3])
+  call sub (func (arg))
+contains
+  function func (a)
+    type(t), pointer :: func
+    type(t), target :: a
+    integer, save :: i = 0
+    if (i /= 0) call abort ! multiple calls would cause this abort
+    i = i + 1
+    func => a
+  end function func
+  subroutine sub (a)
+    type(t), intent(IN), target :: a
+    if (any (a%A .ne. [1,2,3])) call abort
+  end subroutine sub
+end