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

re PR fortran/47565 ([OOP] Segfault with TBP)

Browse Source 
2011-02-01  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/47565
	* trans-expr.c (gfc_conv_structure): Handle constructors for procedure
	pointer components with allocatable result.


2011-02-01  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/47565
	* gfortran.dg/typebound_call_20.f03: New.

From-SVN: r169480
This commit is contained in:
Janus Weil 2011-02-01 15:59:40 +01:00
parent dd3b31fbce
commit 0f0a4367ab
4 changed files with 53 additions and 1 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 @@
2011-02-01 Janus Weil <janus@gcc.gnu.org>
PR fortran/47565
* trans-expr.c (gfc_conv_structure): Handle constructors for procedure
pointer components with allocatable result.
2011-01-31 Janus Weil <janus@gcc.gnu.org>
PR fortran/47455

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

@ -4627,7 +4627,7 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init)
components. Although the latter have a default initializer
of EXPR_NULL,... by default, the static nullify is not needed
since this is done every time we come into scope. */
if (!c->expr || cm->attr.allocatable)
if (!c->expr || (cm->attr.allocatable && cm->attr.flavor != FL_PROCEDURE))
continue;
if (strcmp (cm->name, "_size") == 0)

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2011-02-01 Janus Weil <janus@gcc.gnu.org>
PR fortran/47565
* gfortran.dg/typebound_call_20.f03: New.
2011-02-01 Richard Guenther <rguenther@suse.de>
PR tree-optimization/47555

41
gcc/testsuite/gfortran.dg/typebound_call_20.f03 Normal file
View File

@ -0,0 +1,41 @@
! { dg-do run }
!
! PR 47565: [4.6 Regression][OOP] Segfault with TBP
!
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
module class_t
type :: t
procedure(find_y), pointer, nopass :: ppc
contains
procedure, nopass :: find_y
end type
integer, private :: count = 0
contains
function find_y() result(res)
integer, allocatable :: res
allocate(res)
count = count + 1
res = count
end function
end module
program p
use class_t
class(t), allocatable :: this
integer :: y
allocate(this)
this%ppc => find_y
! (1) ordinary procedure
y = find_y()
if (y/=1) call abort()
! (2) procedure pointer component
y = this%ppc()
if (y/=2) call abort()
! (3) type-bound procedure
y = this%find_y()
if (y/=3) call abort()
end
! { dg-final { cleanup-modules "class_t" } }