OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

2009-07-09  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-07-09  Paul Thomas  <pault@gcc.gnu.org>

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

From-SVN: r149431
This commit is contained in:
Paul Thomas 2009-07-09 19:28:20 +00:00
parent cb23bb8848
commit 3a32e4ebc7
4 changed files with 40 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
2009-07-09 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-07-05 Paul Thomas <pault@gcc.gnu.org>
PR fortran/40551

1
gcc/fortran/trans-expr.c
View File

@ -2723,6 +2723,7 @@ gfc_conv_function_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;

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2009-07-09 Paul Thomas <pault@gcc.gnu.org>
PR fortran/40440
* gfortran.dg/alloc_comp_result_2.f90: New test.
2009-07-09 Dodji Seketeli <dodji@redhat.com>
PR c++/40684

28
gcc/testsuite/gfortran.dg/alloc_comp_result_2.f90 Normal file
View File

@ -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
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