This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch, fortran] PR40440 - Automatic deallocation component of DT function return value
- From: Paul Richard Thomas <paul dot richard dot thomas at gmail dot com>
- To: fortran at gcc dot gnu dot org, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Fri, 19 Jun 2009 10:56:27 +0200
- Subject: [Patch, fortran] PR40440 - Automatic deallocation component of DT function return value
Attached is an "obvious" fix. I will apply it tonight unless there
are objections.
Bootstrapped and regtested on FC9/x86_64
OK for trunk and, in a week, 4.4?
Paul
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.
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (revision 148395)
+++ gcc/fortran/trans-expr.c (working copy)
@@ -2737,6 +2737,7 @@
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;
Index: gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90 (revision 0)
@@ -0,0 +1,28 @@
+! { 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
+ call sub (func ())
+contains
+ function func ()
+ type(t), pointer :: func
+ type(t), pointer :: targ(:)
+ integer, save :: i = 0
+ if (i /= 0) call abort ! multiple calls would cause this abort
+ i = i + 1
+ allocate (targ(1))
+ func => targ(1)
+ func = t ([1,2,3])
+ 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