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

re PR fortran/84523 (Runtime crash deallocating allocatable array within derived type)

Browse Source 
2018-02-25  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/84523
	* trans-intrinsic.c (gfc_conv_allocated): If the argument se
	has a pre block, add it to the expression pre block.

2018-02-25  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/84523
	* gfortran.dg/pr84523.f90: New test.

From-SVN: r257970
This commit is contained in:
Paul Thomas 2018-02-25 12:41:26 +00:00
parent 6ef1366a55
commit 8fba26f48f
4 changed files with 58 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 @@
2018-02-25 Paul Thomas <pault@gcc.gnu.org>
PR fortran/84523
* trans-intrinsic.c (gfc_conv_allocated): If the argument se
has a pre block, add it to the expression pre block.
2018-02-25 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/78238

5
gcc/fortran/trans-intrinsic.c
View File

@ -7606,6 +7606,11 @@ gfc_conv_allocated (gfc_se *se, gfc_expr *expr)
tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tmp,
fold_convert (TREE_TYPE (tmp), null_pointer_node));
}
/* Components of pointer array references sometimes come back with a pre block. */
if (arg1se.pre.head)
gfc_add_block_to_block (&se->pre, &arg1se.pre);
se->expr = convert (gfc_typenode_for_spec (&expr->ts), tmp);
}

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2018-02-25 Paul Thomas <pault@gcc.gnu.org>
PR fortran/84523
* gfortran.dg/pr84523.f90: New test.
2018-02-25 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/78238

42
gcc/testsuite/gfortran.dg/pr84523.f90 Normal file
View File

@ -0,0 +1,42 @@
! { dg-do run }
!
! Test the fix for PR84523.
!
! Contributed by Harald Anlauf <anlauf@gmx.de>
!
program gfcbug148
implicit none
integer, parameter :: nspots = 80
type t_spot
real, allocatable :: vm(:,:,:)
end type t_spot
type t_rowcol
integer :: nh
type(t_spot), pointer :: spots(:) => NULL ()
end type t_rowcol
type(t_rowcol) :: col
call construct (col, nspots)
call destruct (col)
!========================================================================
contains
!========================================================================
subroutine construct (rc, nh)
type(t_rowcol) ,intent(out) :: rc ! row or column to set
integer ,intent(in) :: nh ! number of spots in a row
rc%nh = nh
allocate (rc%spots(nh))
end subroutine construct
!------------------------------------------------------------------------
subroutine destruct (rc)
type(t_rowcol) ,intent(inout) :: rc ! row or column to free
integer :: k
if (associated (rc%spots)) then
if (size(rc%spots) .ne. nspots) stop 1
do k=1, size(rc% spots)
if (allocated (rc%spots(k)%vm)) stop 2 ! Would segfault in runtime.
end do
deallocate (rc%spots)
endif
nullify (rc%spots)
end subroutine destruct
end program gfcbug148