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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@156418 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f313736ffcbee81c576929a3d0e9d4eee078da95..0271eb9408b1b966994e8ad9e6ac4246dae7ec86 100644 (file)
--- 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 fe98b7e0a5453f767d2268fe8d9b8522fcaea79c..d0aa6adf9c31145f937f4bfc3a720b12d5b69749 100644 (file)
--- 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 95ae8138867b8b56a93d0357b7a79867153cbca6..b5091a9e4d5880d74be8f6d1130ea26388a3d0bd 100644 (file)
--- 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 010d86f2acb8c159856ef59527be0fa3653e0027..dd3d10db5d65e0174b426b6a4ed2e65acf46ac28 100644 (file)
--- 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 a107392e094556fb4abdd7a5c3a1023ab010fb9e..a5bb641878063cc7e7315a1fb9839d98ae65aa49 100644 (file)
--- 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 482f1962b45e72aaae4119d041af27bfe4d2f422..a2d83441672d5c34ee643ecbdda42bb6ae9cb264 100644 (file)
--- 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 (file)
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