re PR fortran/44541 ([OOP] wrong code for polymorphic variable with INTENT(OUT)/Alloc w/ MOLD)

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

	PR fortran/44541
	* class.c (gfc_find_derived_vtab): Add component '$def_init'.
	* resolve.c (resolve_allocate_expr): Defer handling of default
	initialization to 'gfc_trans_allocate'.
	(apply_default_init,resolve_symbol): Handle polymorphic dummies.
	(resolve_fl_derived): Suppress error messages for vtypes.
	* trans-stmt.c (gfc_trans_allocate): Handle initialization via
	polymorphic MOLD expression.
	* trans-expr.c (gfc_trans_class_init_assign): Now only used for
	dummy initialization.


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

	PR fortran/44541
	* gfortran.dg/allocate_alloc_opt_10.f90: Extended.
	* gfortran.dg/class_dummy_1.f03: New.

From-SVN: r163744

1 files changed, 24 insertions, 12 deletions

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index b4bc8ca..937a832 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -5760,27 +5760,39 @@ gfc_trans_assign (gfc_code * code)
 }
 
 
-/* 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.  */
+/* Special case for initializing a polymorphic dummy with INTENT(OUT).
+   A MEMCPY is needed to copy the full data from the default initializer
+   of the dynamic type.  */
 
 tree
 gfc_trans_class_init_assign (gfc_code *code)
 {
   stmtblock_t block;
-  tree tmp, memsz;
-  gfc_se dst,src;
-  
+  tree tmp;
+  gfc_se dst,src,memsz;
+  gfc_expr *lhs,*rhs,*sz;
+
   gfc_start_block (&block);
-  
+
+  lhs = gfc_copy_expr (code->expr1);
+  gfc_add_component_ref (lhs, "$data");
+
+  rhs = gfc_copy_expr (code->expr1);
+  gfc_add_component_ref (rhs, "$vptr");
+  gfc_add_component_ref (rhs, "$def_init");
+
+  sz = gfc_copy_expr (code->expr1);
+  gfc_add_component_ref (sz, "$vptr");
+  gfc_add_component_ref (sz, "$size");
+
   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_init_se (&memsz, NULL);
+  gfc_conv_expr (&dst, lhs);
+  gfc_conv_expr (&src, rhs);
+  gfc_conv_expr (&memsz, sz);
   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);
+  tmp = gfc_build_memcpy_call (dst.expr, src.expr, memsz.expr);
   gfc_add_expr_to_block (&block, tmp);
   
   return gfc_finish_block (&block);