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

re PR fortran/42888 (ICE in fold_convert_loc, at fold-const.c:2670)

Browse Source 
gcc/fortran/
2010-01-31  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/42888
	* resolve.c (resolve_allocate_expr): Move default initialization code
	here from gfc_trans_allocate.
	* trans.c (gfc_trans_code): Call gfc_trans_class_assign also for
	EXEC_INIT_ASSIGN.
	* trans-expr.c (gfc_trans_class_assign): Handle default initialization
	of CLASS variables via memcpy.
	* trans-stmt.c (gfc_trans_allocate): Move default initialization code
	to resolve_allocate_expr.

gcc/testsuite/
2010-01-31  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/42888
	* gfortran.dg/allocate_derived_2.f90: New test.

From-SVN: r156418
This commit is contained in:
Janus Weil 2010-01-31 22:56:02 +01:00
parent 355b1741d9
commit 7adac79a3d
7 changed files with 92 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/fortran/ChangeLog
View File

@ -1,3 +1,15 @@
2010-01-31 Janus Weil <janus@gcc.gnu.org>
PR fortran/42888
* resolve.c (resolve_allocate_expr): Move default initialization code
here from gfc_trans_allocate.
* trans.c (gfc_trans_code): Call gfc_trans_class_assign also for
EXEC_INIT_ASSIGN.
* trans-expr.c (gfc_trans_class_assign): Handle default initialization
of CLASS variables via memcpy.
* trans-stmt.c (gfc_trans_allocate): Move default initialization code
to resolve_allocate_expr.
2010-01-31 Paul Thomas <pault@gcc.gnu.org>
PR fortran/38324

31
gcc/fortran/resolve.c
View File

@ -6099,6 +6099,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
gfc_symbol *sym;
gfc_alloc *a;
gfc_component *c;
gfc_expr *init_e;
/* Check INTENT(IN), unless the object is a sub-component of a pointer. */
check_intent_in = 1;
@ -6223,6 +6224,36 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
sym->name, &e->where);
return FAILURE;
}
if (!code->expr3)
{
/* Add default initializer for those derived types that need them. */
if (e->ts.type == BT_DERIVED
&& (init_e = gfc_default_initializer (&e->ts)))
{
gfc_code *init_st = gfc_get_code ();
init_st->loc = code->loc;
init_st->op = EXEC_INIT_ASSIGN;
init_st->expr1 = gfc_expr_to_initialize (e);
init_st->expr2 = init_e;
init_st->next = code->next;
code->next = init_st;
}
else if (e->ts.type == BT_CLASS
&& ((code->ext.alloc.ts.type == BT_UNKNOWN
&& (init_e = gfc_default_initializer (&e->ts.u.derived->components->ts)))
|| (code->ext.alloc.ts.type == BT_DERIVED
&& (init_e = gfc_default_initializer (&code->ext.alloc.ts)))))
{
gfc_code *init_st = gfc_get_code ();
init_st->loc = code->loc;
init_st->op = EXEC_INIT_ASSIGN;
init_st->expr1 = gfc_expr_to_initialize (e);
init_st->expr2 = init_e;
init_st->next = code->next;
code->next = init_st;
}
}
if (pointer || dimension == 0)
return SUCCESS;

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

@ -5519,6 +5519,25 @@ gfc_trans_class_assign (gfc_code *code)
gfc_expr *rhs;
gfc_start_block (&block);
if (code->op == EXEC_INIT_ASSIGN)
{
/* Special case for initializing a CLASS variable on allocation.
A MEMCPY is needed to copy the full data of the dynamic type,
which may be different from the declared type. */
gfc_se dst,src;
tree memsz;
gfc_init_se (&dst, NULL);
gfc_init_se (&src, NULL);
gfc_add_component_ref (code->expr1, "$data");
gfc_conv_expr (&dst, code->expr1);
gfc_conv_expr (&src, code->expr2);
gfc_add_block_to_block (&block, &src.pre);
memsz = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->expr2->ts));
tmp = gfc_build_memcpy_call (dst.expr, src.expr, memsz);
gfc_add_expr_to_block (&block, tmp);
return gfc_finish_block (&block);
}
if (code->expr2->ts.type != BT_CLASS)
{

24
gcc/fortran/trans-stmt.c
View File

@ -4018,7 +4018,7 @@ tree
gfc_trans_allocate (gfc_code * code)
{
gfc_alloc *al;
gfc_expr *expr, *init_e;
gfc_expr *expr;
gfc_se se;
tree tmp;
tree parm;
@ -4162,28 +4162,6 @@ gfc_trans_allocate (gfc_code * code)
gfc_free_expr (rhs);
gfc_add_expr_to_block (&block, tmp);
}
/* Default initializer for CLASS variables. */
else if (al->expr->ts.type == BT_CLASS
&& code->ext.alloc.ts.type == BT_DERIVED
&& (init_e = gfc_default_initializer (&code->ext.alloc.ts)))
{
gfc_se dst,src;
gfc_init_se (&dst, NULL);
gfc_init_se (&src, NULL);
gfc_conv_expr (&dst, expr);
gfc_conv_expr (&src, init_e);
gfc_add_block_to_block (&block, &src.pre);
tmp = gfc_build_memcpy_call (dst.expr, src.expr, memsz);
gfc_add_expr_to_block (&block, tmp);
}
/* Add default initializer for those derived types that need them. */
else if (expr->ts.type == BT_DERIVED
&& (init_e = gfc_default_initializer (&expr->ts)))
{
tmp = gfc_trans_assignment (gfc_expr_to_initialize (expr),
init_e, true);
gfc_add_expr_to_block (&block, tmp);
}
/* Allocation of CLASS entities. */
gfc_free_expr (expr);

5
gcc/fortran/trans.c
View File

@ -1098,7 +1098,10 @@ gfc_trans_code (gfc_code * code)
break;
case EXEC_INIT_ASSIGN:
res = gfc_trans_init_assign (code);
if (code->expr1->ts.type == BT_CLASS)
res = gfc_trans_class_assign (code);
else
res = gfc_trans_init_assign (code);
break;
case EXEC_CONTINUE:

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2010-01-31 Janus Weil <janus@gcc.gnu.org>
PR fortran/42888
* gfortran.dg/allocate_derived_2.f90: New test.
2010-01-31 Eric Botcazou <ebotcazou@adacore.com>
PR middle-end/42898

20
gcc/testsuite/gfortran.dg/allocate_derived_2.f90 Normal file
View File

@ -0,0 +1,20 @@
! { dg-do compile }
!
! PR 42888: [4.5 Regression] ICE in fold_convert_loc, at fold-const.c:2670
!
! Contributed by Harald Anlauf <anlauf@gmx.de>
implicit none
type t
integer :: X = -999.0 ! Real initializer!
end type t
type(t), allocatable :: x
class(t), allocatable :: y,z
allocate (x)
allocate (y)
allocate (t::z)
end