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

re PR fortran/86328 (Runtime segfault reading an allocatable class(*) object in allocate statements) 

2018-08-31  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/86328
	PR fortran/86760
	* trans-array.c (gfc_conv_scalarized_array_ref): Do not fix
	info->descriptor but pass it directly to gfc_build_array_ref.
	(gfc_conv_array_ref): Likewise for se->expr.
	* trans.c (gfc_build_array_ref): If 'decl' is a COMPONENT_REF
	obtain the span field directly from it.

2018-08-31  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/86328
	PR fortran/86760
	* gfortran.dg/pr86328.f90 : New test.
	in comment 12 of the PR.
	* gfortran.dg/pr86760.f90 : New test.

From-SVN: r264008
This commit is contained in:
Paul Thomas 2018-08-31 06:51:31 +00:00
parent ee3ec8ac28
commit 4e227341f6
6 changed files with 132 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
gcc/fortran/ChangeLog
View File

@ -1,3 +1,13 @@
2018-08-31 Paul Thomas <pault@gcc.gnu.org>
PR fortran/86328
PR fortran/86760
* trans-array.c (gfc_conv_scalarized_array_ref): Do not fix
info->descriptor but pass it directly to gfc_build_array_ref.
(gfc_conv_array_ref): Likewise for se->expr.
* trans.c (gfc_build_array_ref): If 'decl' is a COMPONENT_REF
obtain the span field directly from it.
2017-08-28 Paul Thomas <pault@gcc.gnu.org>
PR fortran/80477

12
gcc/fortran/trans-array.c
View File

@ -3414,11 +3414,7 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar)
if (is_pointer_array (info->descriptor))
{
if (TREE_CODE (info->descriptor) == COMPONENT_REF)
{
decl = gfc_evaluate_now (info->descriptor, &se->pre);
GFC_DECL_PTR_ARRAY_P (decl) = 1;
TREE_USED (decl) = 1;
}
decl = info->descriptor;
else if (TREE_CODE (info->descriptor) == INDIRECT_REF)
decl = TREE_OPERAND (info->descriptor, 0);
@ -3659,11 +3655,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr,
&& is_pointer_array (se->expr))
{
if (TREE_CODE (se->expr) == COMPONENT_REF)
{
decl = gfc_evaluate_now (se->expr, &se->pre);
GFC_DECL_PTR_ARRAY_P (decl) = 1;
TREE_USED (decl) = 1;
}
decl = se->expr;
else if (TREE_CODE (se->expr) == INDIRECT_REF)
decl = TREE_OPERAND (se->expr, 0);
else

7
gcc/fortran/trans.c
View File

@ -407,7 +407,12 @@ gfc_build_array_ref (tree base, tree offset, tree decl, tree vptr)
if (vptr)
span = gfc_vptr_size_get (vptr);
else if (decl)
span = get_array_span (type, decl);
{
if (TREE_CODE (decl) == COMPONENT_REF)
span = gfc_conv_descriptor_span_get (decl);
else
span = get_array_span (type, decl);
}
/* If a non-null span has been generated reference the element with
pointer arithmetic. */

8
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,11 @@
2018-08-31 Paul Thomas <pault@gcc.gnu.org>
PR fortran/86328
PR fortran/86760
* gfortran.dg/pr86328.f90 : New test.
in comment 12 of the PR.
* gfortran.dg/pr86760.f90 : New test.
2018-08-30 Sandra Loosemore <sandra@codesourcery.com>
* g++.dg/cpp0x/noexcept30.C: Make dependence on

49
gcc/testsuite/gfortran.dg/pr86328.f90 Normal file
View File

@ -0,0 +1,49 @@
! { dg-do run }
!
! Test the fix for PR86328 in which temporaries were not being
! assigned for array component references.
!
! Contributed by Martin <mscfd@gmx.net>
!
program ptr_alloc
type :: t
class(*), allocatable :: val
end type
type :: list
type(t), dimension(:), pointer :: ll
end type
integer :: i
type(list) :: a
allocate(a%ll(1:2))
do i = 1,2
allocate(a%ll(i)%val, source=i)
end do
do i = 1,2
call rrr(a, i)
end do
do i = 1,2
deallocate(a%ll(i)%val)
end do
deallocate (a%ll)
contains
subroutine rrr(a, i)
type(list), intent(in) :: a
class(*), allocatable :: c
integer :: i
allocate(c, source=a%ll(i)%val)
select type (c)
type is (integer)
if (c .ne. i) stop 1
end select
end subroutine
end

57
gcc/testsuite/gfortran.dg/pr86760.f90 Normal file
View File

@ -0,0 +1,57 @@
! { dg-do run }
!
! Test the fix for PR86760 in which temporaries were not being
! assigned for array component references.
!
! Contributed by Chris Hansen <hansec@uw.edu>
!
MODULE test_nesting_mod
IMPLICIT NONE
TYPE :: test_obj1
CONTAINS
PROCEDURE :: destroy
END TYPE
TYPE :: obj_ptr
CLASS(test_obj1), POINTER :: f => NULL()
END TYPE
TYPE :: obj_container
TYPE(obj_ptr), POINTER, DIMENSION(:) :: v => NULL()
END TYPE
integer :: ctr = 0
CONTAINS
SUBROUTINE destroy(self)
CLASS(test_obj1), INTENT(INOUT):: self
ctr = ctr + 1
END SUBROUTINE
SUBROUTINE container_destroy(self)
type(obj_container), INTENT(INOUT) :: self
INTEGER :: i
DO i=1,ubound(self%v,1)
CALL self%v(i)%f%destroy()
END DO
END SUBROUTINE
END MODULE
PROGRAM test_nesting_ptr
USE test_nesting_mod
IMPLICIT NONE
INTEGER :: i
INTEGER, PARAMETER :: n = 2
TYPE(obj_container) :: var
ALLOCATE(var%v(n))
DO i=1,n
ALLOCATE(test_obj1::var%v(i)%f)
END DO
CALL container_destroy(var)
if (ctr .ne. 2) stop 1
END