re PR fortran/47024 ([OOP] STORAGE_SIZE (for polymorphic types): Segfault at run time)

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

	PR fortran/47024
	* trans-decl.c (gfc_trans_deferred_vars): Initialize the _vpr component
	of polymorphic allocatables according to their declared type.


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

	PR fortran/47024
	* gfortran.dg/storage_size_3.f08: New.

From-SVN: r168505
This commit is contained in:
Janus Weil 2011-01-05 10:05:44 +01:00
parent 6452b11201
commit 8c077737e2
4 changed files with 41 additions and 3 deletions

View file

@ -1,3 +1,9 @@
2011-01-05 Janus Weil <janus@gcc.gnu.org>
PR fortran/47024
* trans-decl.c (gfc_trans_deferred_vars): Initialize the _vpr component
of polymorphic allocatables according to their declared type.
2011-01-04 Janus Weil <janus@gcc.gnu.org>
PR fortran/46448

View file

@ -3312,7 +3312,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
{
/* Nullify and automatic deallocation of allocatable
scalars. */
tree tmp;
tree tmp = NULL;
gfc_expr *e;
gfc_se se;
stmtblock_t init;
@ -3337,8 +3337,23 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
if (!sym->attr.result)
tmp = gfc_deallocate_scalar_with_status (se.expr, NULL, true,
NULL, sym->ts);
else
tmp = NULL;
if (sym->ts.type == BT_CLASS)
{
/* Initialize _vptr to declared type. */
gfc_symbol *vtab = gfc_find_derived_vtab (sym->ts.u.derived);
tree rhs;
e = gfc_lval_expr_from_sym (sym);
gfc_add_vptr_component (e);
gfc_init_se (&se, NULL);
se.want_pointer = 1;
gfc_conv_expr (&se, e);
gfc_free_expr (e);
rhs = gfc_build_addr_expr (TREE_TYPE (se.expr),
gfc_get_symbol_decl (vtab));
gfc_add_modify (&init, se.expr, rhs);
}
gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp);
}
}

View file

@ -1,3 +1,8 @@
2011-01-05 Janus Weil <janus@gcc.gnu.org>
PR fortran/47024
* gfortran.dg/storage_size_3.f08: New.
2011-01-04 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/47154

View file

@ -0,0 +1,12 @@
! { dg-do run }
!
! PR 47024: [OOP] STORAGE_SIZE (for polymorphic types): Segfault at run time
!
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
type t
integer(kind=4) :: a
end type
class(t), allocatable :: y
if (storage_size(y)/=32) call abort()
end