Commit 255388b8 by Andre Vehreschild

re PR fortran/66035 (gfortran ICE segfault)

gcc/fortran/ChangeLog:

2015-07-17  Andre Vehreschild  <vehre@gcc.gnu.org>

	PR fortran/66035
	* trans-expr.c (alloc_scalar_allocatable_for_subcomponent_assignment):
	Compute the size to allocate for class and derived type objects
	correclty.
	(gfc_trans_subcomponent_assign): Only allocate memory for a
	component when the object to assign is not an allocatable class
	object (the memory is already present for allocatable class objects).
	Furthermore use copy_class_to_class for assigning the rhs to the
	component (may happen for dummy class objects on the rhs).


gcc/testsuite/ChangeLog:

2015-07-17  Andre Vehreschild  <vehre@gcc.gnu.org>

	PR fortran/66035
	* gfortran.dg/structure_constructor_13.f03: New test.

From-SVN: r225928
parent 0e1f8c6a
2015-07-17 Andre Vehreschild <vehre@gcc.gnu.org>
PR fortran/66035
* trans-expr.c (alloc_scalar_allocatable_for_subcomponent_assignment):
Compute the size to allocate for class and derived type objects
correclty.
(gfc_trans_subcomponent_assign): Only allocate memory for a
component when the object to assign is not an allocatable class
object (the memory is already present for allocatable class objects).
Furthermore use copy_class_to_class for assigning the rhs to the
component (may happen for dummy class objects on the rhs).
2015-07-17 Mikael Morin <mikael@gcc.gnu.org> 2015-07-17 Mikael Morin <mikael@gcc.gnu.org>
Dominique d'Humieres <dominiq@lps.ens.fr> Dominique d'Humieres <dominiq@lps.ens.fr>
......
...@@ -6969,6 +6969,29 @@ alloc_scalar_allocatable_for_subcomponent_assignment (stmtblock_t *block, ...@@ -6969,6 +6969,29 @@ alloc_scalar_allocatable_for_subcomponent_assignment (stmtblock_t *block,
TREE_TYPE (tmp), tmp, TREE_TYPE (tmp), tmp,
fold_convert (TREE_TYPE (tmp), size)); fold_convert (TREE_TYPE (tmp), size));
} }
else if (cm->ts.type == BT_CLASS)
{
gcc_assert (expr2->ts.type == BT_CLASS || expr2->ts.type == BT_DERIVED);
if (expr2->ts.type == BT_DERIVED)
{
tmp = gfc_get_symbol_decl (expr2->ts.u.derived);
size = TYPE_SIZE_UNIT (tmp);
}
else
{
gfc_expr *e2vtab;
gfc_se se;
e2vtab = gfc_find_and_cut_at_last_class_ref (expr2);
gfc_add_vptr_component (e2vtab);
gfc_add_size_component (e2vtab);
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, e2vtab);
gfc_add_block_to_block (block, &se.pre);
size = fold_convert (size_type_node, se.expr);
gfc_free_expr (e2vtab);
}
size_in_bytes = size;
}
else else
{ {
/* Otherwise use the length in bytes of the rhs. */ /* Otherwise use the length in bytes of the rhs. */
...@@ -7096,7 +7119,8 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr, ...@@ -7096,7 +7119,8 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr,
gfc_add_expr_to_block (&block, tmp); gfc_add_expr_to_block (&block, tmp);
} }
else if (init && (cm->attr.allocatable else if (init && (cm->attr.allocatable
|| (cm->ts.type == BT_CLASS && CLASS_DATA (cm)->attr.allocatable))) || (cm->ts.type == BT_CLASS && CLASS_DATA (cm)->attr.allocatable
&& expr->ts.type != BT_CLASS)))
{ {
/* Take care about non-array allocatable components here. The alloc_* /* Take care about non-array allocatable components here. The alloc_*
routine below is motivated by the alloc_scalar_allocatable_for_ routine below is motivated by the alloc_scalar_allocatable_for_
......
2015-07-17 Andre Vehreschild <vehre@gcc.gnu.org>
PR fortran/66035
* gfortran.dg/structure_constructor_13.f03: New test.
2015-07-17 Mikael Morin <mikael@gcc.gnu.org> 2015-07-17 Mikael Morin <mikael@gcc.gnu.org>
PR fortran/61831 PR fortran/61831
......
! { dg-do run }
!
! Contributed by Melven Roehrig-Zoellner <Melven.Roehrig-Zoellner@DLR.de>
! PR fortran/66035
program test_pr66035
type t
end type t
type w
class(t), allocatable :: c
end type w
type(t) :: o
call test(o)
contains
subroutine test(o)
class(t), intent(inout) :: o
type(w), dimension(:), allocatable :: list
select type (o)
class is (t)
list = [w(o)] ! This caused an ICE
class default
call abort()
end select
end subroutine
end program
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment