2010-09-04 Janus Weil <janus@gcc.gnu.org>

	PR fortran/45507
	* resolve.c (resolve_allocate_expr): Generate default initializers
	already at this point, resolve them and put them into expr3, ...
	* trans-stmt.c (gfc_trans_allocate): ... instead of waiting until
	translation stage.


2010-09-04  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/45507
	* gfortran.dg/allocate_alloc_opt_12.f90: New.


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

5 files changed, 77 insertions, 47 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 517ca841f0e..428cd3f25cf 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2010-09-04  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/45507
+	* resolve.c (resolve_allocate_expr): Generate default initializers
+	already at this point, resolve them and put them into expr3, ...
+	* trans-stmt.c (gfc_trans_allocate): ... instead of waiting until
+	translation stage.
+
 2010-09-03  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/45186
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 88f43cdfcbf..9099ada8f51 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -6714,6 +6714,34 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
       goto failure;
     }
 
+  if (!code->expr3)
+    {
+      /* Set up default initializer if needed.  */
+      gfc_typespec ts;
+
+      if (code->ext.alloc.ts.type == BT_DERIVED)
+	ts = code->ext.alloc.ts;
+      else
+	ts = e->ts;
+
+      if (ts.type == BT_CLASS)
+	ts = ts.u.derived->components->ts;
+
+      if (ts.type == BT_DERIVED)
+	{
+	  code->expr3 = gfc_default_initializer (&ts);
+	  gfc_resolve_expr (code->expr3);
+	}
+    }
+  else if (code->expr3->mold && code->expr3->ts.type == BT_DERIVED)
+    {
+      /* Default initialization via MOLD (non-polymorphic).  */
+      gfc_expr *rhs = gfc_default_initializer (&code->expr3->ts);
+      gfc_resolve_expr (rhs);
+      gfc_free_expr (code->expr3);
+      code->expr3 = rhs;
+    }
+
   if (e->ts.type == BT_CLASS)
     {
       /* Make sure the vtab symbol is present when
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 29b33228058..dda38b6503e 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -4475,9 +4475,10 @@ gfc_trans_allocate (gfc_code * code)
       tmp = gfc_finish_block (&se.pre);
       gfc_add_expr_to_block (&block, tmp);
 
-      /* Initialization via SOURCE block.  */
       if (code->expr3 && !code->expr3->mold)
 	{
+	  /* Initialization via SOURCE block
+	     (or static default initializer).  */
 	  gfc_expr *rhs = gfc_copy_expr (code->expr3);
 	  if (al->expr->ts.type == BT_CLASS)
 	    {
@@ -4497,53 +4498,22 @@ gfc_trans_allocate (gfc_code * code)
 	  gfc_free_expr (rhs);
 	  gfc_add_expr_to_block (&block, tmp);
 	}
-      else
+      else if (code->expr3 && code->expr3->mold
+	    && code->expr3->ts.type == BT_CLASS)
 	{
-	  /* Add default initializer for those derived types that need them.  */
-	  gfc_expr *rhs = NULL;
-	  gfc_typespec ts;
-
-	  if (code->ext.alloc.ts.type == BT_DERIVED)
-	    ts = code->ext.alloc.ts;
-	  else if (code->expr3)
-	    ts = code->expr3->ts;
-	  else
-	    ts = expr->ts;
-
-	  if (ts.type == BT_DERIVED)
-	    {
-	      rhs = gfc_default_initializer (&ts);
-	      gfc_resolve_expr (rhs);
-	    }
-	  else if (ts.type == BT_CLASS)
-	    {
-	      rhs = gfc_copy_expr (code->expr3);
-	      gfc_add_component_ref (rhs, "$vptr");
-	      gfc_add_component_ref (rhs, "$def_init");
-	    }
-
-	  if (rhs)
-	    {
-	      gfc_expr *lhs = gfc_expr_to_initialize (expr);
-	      if (al->expr->ts.type == BT_DERIVED)
-		{
-		  tmp = gfc_trans_assignment (lhs, rhs, true, false);
-		  gfc_add_expr_to_block (&block, tmp);
-		}
-	      else if (al->expr->ts.type == BT_CLASS)
-		{
-		  gfc_se dst,src;
-		  gfc_init_se (&dst, NULL);
-		  gfc_init_se (&src, NULL);
-		  gfc_conv_expr (&dst, lhs);
-		  gfc_conv_expr (&src, rhs);
-		  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);
-		}
-	      gfc_free_expr (lhs);
-	      gfc_free_expr (rhs);
-	    }
+	  /* Default-initialization via MOLD (polymorphic).  */
+	  gfc_expr *rhs = gfc_copy_expr (code->expr3);
+	  gfc_se dst,src;
+	  gfc_add_component_ref (rhs, "$vptr");
+	  gfc_add_component_ref (rhs, "$def_init");
+	  gfc_init_se (&dst, NULL);
+	  gfc_init_se (&src, NULL);
+	  gfc_conv_expr (&dst, expr);
+	  gfc_conv_expr (&src, rhs);
+	  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);
+	  gfc_free_expr (rhs);
 	}
 
       /* Allocation of CLASS entities.  */
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 9834ddd02f8..52dd4e875ed 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2010-09-04  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/45507
+	* gfortran.dg/allocate_alloc_opt_12.f90: New.
+
 2010-09-03  Joseph Myers  <joseph@codesourcery.com>
 
 	* gcc.dg/opts-4.c: New test.
diff --git a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_12.f90 b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_12.f90
new file mode 100644
index 00000000000..2af06929353
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_12.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+!
+! PR 45507: [4.6 Regression] Bogus Error: Can't convert TYPE(c_ptr) to INTEGER(4)
+!
+! Contributed by Andrew Benson <abenson@its.caltech.edu>
+
+ use, intrinsic :: iso_c_binding
+
+ type :: cType
+   type(c_ptr) :: accelPtr = c_null_ptr
+ end type cType
+
+ type(cType), allocatable, dimension(:) :: filters
+ class(cType), allocatable :: f
+
+ allocate(filters(1))
+ allocate(f,MOLD=filters(1))
+
+end