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

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

7 files changed, 92 insertions, 24 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f313736..0271eb9 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index fe98b7e..d0aa6ad 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -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;
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 95ae813..b5091a9 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -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)
     {
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 010d86f..dd3d10d 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -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);
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index a107392..a5bb641 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -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:
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 482f196..a2d8344 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/allocate_derived_2.f90 b/gcc/testsuite/gfortran.dg/allocate_derived_2.f90
new file mode 100644
index 0000000..8d01224
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_derived_2.f90
@@ -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