re PR fortran/51529 ([OOP] gfortran.dg/class_to_type_1.f03 is miscompiled: Uninitialized variable used)

2012-01-02  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/51529
	* trans-array.c (gfc_array_allocate): Null allocated memory of
	newly allocted class arrays.

	PR fortran/46262
	PR fortran/46328
	PR fortran/51052
	* interface.c(build_compcall_for_operator): Add a type to the
	expression.
	* trans-expr.c (conv_base_obj_fcn_val): New function.
	(gfc_conv_procedure_call): Use base_expr to detect non-variable
	base objects and, ensuring that there is a temporary variable,
	build up the typebound call using conv_base_obj_fcn_val.
	(gfc_trans_class_assign): Pick out class procedure pointer
	assignments and do the assignment with no further prcessing.
	(gfc_trans_class_array_init_assign, gfc_trans_class_init_assign
	gfc_trans_class_assign): Move to top of file.
	* gfortran.h : Add 'base_expr' field to gfc_expr.
	* resolve.c (get_declared_from_expr): Add 'types' argument to
	switch checking of derived types on or off.
	(resolve_typebound_generic_call): Set the new argument.
	(resolve_typebound_function, resolve_typebound_subroutine):
	Set 'types' argument for get_declared_from_expr appropriately.
	Identify base expression, if not a variable, in the argument
	list of class valued calls. Assign it to the 'base_expr' field
	of the final expression. Strip away all references after the
	last class reference.


2012-01-02  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/46262
	PR fortran/46328
	PR fortran/51052
	* gfortran.dg/typebound_operator_7.f03: New.
	* gfortran.dg/typebound_operator_8.f03: New.

From-SVN: r182796

7 files changed, 346 insertions, 170 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index af5fd93..02c0def 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,33 @@
+2012-01-02  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/51529
+	* trans-array.c (gfc_array_allocate): Null allocated memory of
+	newly allocted class arrays.
+
+	PR fortran/46262
+	PR fortran/46328
+	PR fortran/51052
+	* interface.c(build_compcall_for_operator): Add a type to the
+	expression.
+	* trans-expr.c (conv_base_obj_fcn_val): New function.
+	(gfc_conv_procedure_call): Use base_expr to detect non-variable
+	base objects and, ensuring that there is a temporary variable,
+	build up the typebound call using conv_base_obj_fcn_val.
+	(gfc_trans_class_assign): Pick out class procedure pointer
+	assignments and do the assignment with no further prcessing.
+	(gfc_trans_class_array_init_assign, gfc_trans_class_init_assign
+	gfc_trans_class_assign): Move to top of file.
+	* gfortran.h : Add 'base_expr' field to gfc_expr.
+	* resolve.c (get_declared_from_expr): Add 'types' argument to
+	switch checking of derived types on or off.
+	(resolve_typebound_generic_call): Set the new argument.
+	(resolve_typebound_function, resolve_typebound_subroutine):
+	Set 'types' argument for get_declared_from_expr appropriately.
+	Identify base expression, if not a variable, in the argument
+	list of class valued calls. Assign it to the 'base_expr' field
+	of the final expression. Strip away all references after the
+	last class reference.
+
 2012-01-02  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/51682
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index af2cd85..c715b30 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -2330,3 +2330,4 @@ gfc_dump_parse_tree (gfc_namespace *ns, FILE *file)
   dumpfile = file;
   show_namespace (ns);
 }
+
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index daa2896..5923069 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1,6 +1,6 @@
 /* gfortran header file
    Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-   2009, 2010, 2011
+   2009, 2010, 2011, 2012
    Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
@@ -1697,6 +1697,10 @@ typedef struct gfc_expr
 
   locus where;
 
+  /* Used to store the base expression in component calls, when the expression
+     is not a variable.  */
+  gfc_expr *base_expr;
+
   /* is_boz is true if the integer is regarded as BOZ bitpatten and is_snan
      denotes a signalling not-a-number.  */
   unsigned int is_boz : 1, is_snan : 1;
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index e914c6c..773749d 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1,6 +1,6 @@
 /* Deal with interfaces.
    Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008, 2009,
-   2010
+   2010, 2011, 2012
    Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
@@ -3256,6 +3256,14 @@ build_compcall_for_operator (gfc_expr* e, gfc_actual_arglist* actual,
   e->value.compcall.base_object = base;
   e->value.compcall.ignore_pass = 1;
   e->value.compcall.assign = 0;
+  if (e->ts.type == BT_UNKNOWN
+	&& target->function)
+    {
+      if (target->is_generic)
+	e->ts = target->u.generic->specific->u.specific->n.sym->ts;
+      else
+	e->ts = target->u.specific->n.sym->ts;
+    }
 }
 
 
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 0c27b23..82045f8 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -1,6 +1,6 @@
 /* Perform type resolution on the various structures.
    Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
-   2010, 2011
+   2010, 2011, 2012
    Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
@@ -5620,10 +5620,11 @@ resolve_typebound_static (gfc_expr* e, gfc_symtree** target,
 
 /* Get the ultimate declared type from an expression.  In addition,
    return the last class/derived type reference and the copy of the
-   reference list.  */
+   reference list.  If check_types is set true, derived types are
+   identified as well as class references.  */
 static gfc_symbol*
 get_declared_from_expr (gfc_ref **class_ref, gfc_ref **new_ref,
-			gfc_expr *e)
+			gfc_expr *e, bool check_types)
 {
   gfc_symbol *declared;
   gfc_ref *ref;
@@ -5639,8 +5640,9 @@ get_declared_from_expr (gfc_ref **class_ref, gfc_ref **new_ref,
       if (ref->type != REF_COMPONENT)
 	continue;
 
-      if (ref->u.c.component->ts.type == BT_CLASS
-	    || ref->u.c.component->ts.type == BT_DERIVED)
+      if ((ref->u.c.component->ts.type == BT_CLASS
+	     || (check_types && ref->u.c.component->ts.type == BT_DERIVED))
+	  && ref->u.c.component->attr.flavor != FL_PROCEDURE)
 	{
 	  declared = ref->u.c.component->ts.u.derived;
 	  if (class_ref)
@@ -5735,7 +5737,7 @@ resolve_typebound_generic_call (gfc_expr* e, const char **name)
 
 success:
   /* Make sure that we have the right specific instance for the name.  */
-  derived = get_declared_from_expr (NULL, NULL, e);
+  derived = get_declared_from_expr (NULL, NULL, e, true);
 
   st = gfc_find_typebound_proc (derived, NULL, genname, true, &e->where);
   if (st)
@@ -5852,7 +5854,7 @@ resolve_compcall (gfc_expr* e, const char **name)
 /* Resolve a typebound function, or 'method'. First separate all
    the non-CLASS references by calling resolve_compcall directly.  */
 
-static gfc_try
+gfc_try
 resolve_typebound_function (gfc_expr* e)
 {
   gfc_symbol *declared;
@@ -5872,6 +5874,21 @@ resolve_typebound_function (gfc_expr* e)
   overridable = !e->value.compcall.tbp->non_overridable;
   if (expr && expr->ts.type == BT_CLASS && e->value.compcall.name)
     {
+      /* If the base_object is not a variable, the corresponding actual
+	 argument expression must be stored in e->base_expression so
+	 that the corresponding tree temporary can be used as the base
+	 object in gfc_conv_procedure_call.  */
+      if (expr->expr_type != EXPR_VARIABLE)
+	{
+	  gfc_actual_arglist *args;
+
+	  for (args= e->value.function.actual; args; args = args->next)
+	    {
+	      if (expr == args->expr)
+		expr = args->expr;
+	    }
+	}
+
       /* Since the typebound operators are generic, we have to ensure
 	 that any delays in resolution are corrected and that the vtab
 	 is present.  */
@@ -5888,9 +5905,26 @@ resolve_typebound_function (gfc_expr* e)
       name = name ? name : e->value.function.esym->name;
       e->symtree = expr->symtree;
       e->ref = gfc_copy_ref (expr->ref);
+      get_declared_from_expr (&class_ref, NULL, e, false);
+
+      /* Trim away the extraneous references that emerge from nested
+	 use of interface.c (extend_expr).  */
+      if (class_ref && class_ref->next)
+	{
+	  gfc_free_ref_list (class_ref->next);
+	  class_ref->next = NULL;
+	}
+      else if (e->ref && !class_ref)
+	{
+	  gfc_free_ref_list (e->ref);
+	  e->ref = NULL;
+	}
+
       gfc_add_vptr_component (e);
       gfc_add_component_ref (e, name);
       e->value.function.esym = NULL;
+      if (expr->expr_type != EXPR_VARIABLE)
+	e->base_expr = expr;
       return SUCCESS;
     }
 
@@ -5901,7 +5935,7 @@ resolve_typebound_function (gfc_expr* e)
     return FAILURE;
 
   /* Get the CLASS declared type.  */
-  declared = get_declared_from_expr (&class_ref, &new_ref, e);
+  declared = get_declared_from_expr (&class_ref, &new_ref, e, true);
 
   /* Weed out cases of the ultimate component being a derived type.  */
   if ((class_ref && class_ref->u.c.component->ts.type == BT_DERIVED)
@@ -5967,6 +6001,20 @@ resolve_typebound_subroutine (gfc_code *code)
   overridable = !code->expr1->value.compcall.tbp->non_overridable;
   if (expr && expr->ts.type == BT_CLASS && code->expr1->value.compcall.name)
     {
+      /* If the base_object is not a variable, the corresponding actual
+	 argument expression must be stored in e->base_expression so
+	 that the corresponding tree temporary can be used as the base
+	 object in gfc_conv_procedure_call.  */
+      if (expr->expr_type != EXPR_VARIABLE)
+	{
+	  gfc_actual_arglist *args;
+
+	  args= code->expr1->value.function.actual;
+	  for (; args; args = args->next)
+	    if (expr == args->expr)
+	      expr = args->expr;
+	}
+
       /* Since the typebound operators are generic, we have to ensure
 	 that any delays in resolution are corrected and that the vtab
 	 is present.  */
@@ -5982,9 +6030,27 @@ resolve_typebound_subroutine (gfc_code *code)
       name = name ? name : code->expr1->value.function.esym->name;
       code->expr1->symtree = expr->symtree;
       code->expr1->ref = gfc_copy_ref (expr->ref);
+
+      /* Trim away the extraneous references that emerge from nested
+	 use of interface.c (extend_expr).  */
+      get_declared_from_expr (&class_ref, NULL, code->expr1, false);
+      if (class_ref && class_ref->next)
+	{
+	  gfc_free_ref_list (class_ref->next);
+	  class_ref->next = NULL;
+	}
+      else if (code->expr1->ref && !class_ref)
+	{
+	  gfc_free_ref_list (code->expr1->ref);
+	  code->expr1->ref = NULL;
+	}
+
+      /* Now use the procedure in the vtable.  */
       gfc_add_vptr_component (code->expr1);
       gfc_add_component_ref (code->expr1, name);
       code->expr1->value.function.esym = NULL;
+      if (expr->expr_type != EXPR_VARIABLE)
+	code->expr1->base_expr = expr;
       return SUCCESS;
     }
 
@@ -5995,7 +6061,7 @@ resolve_typebound_subroutine (gfc_code *code)
     return FAILURE;
 
   /* Get the CLASS declared type.  */
-  get_declared_from_expr (&class_ref, &new_ref, code->expr1);
+  get_declared_from_expr (&class_ref, &new_ref, code->expr1, true);
 
   /* Weed out cases of the ultimate component being a derived type.  */
   if ((class_ref && class_ref->u.c.component->ts.type == BT_DERIVED)
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index a644312..50e1ee4 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -1,6 +1,6 @@
 /* Array translation routines
    Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
-   2011
+   2011, 2012
    Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
    and Steven Bosscher <s.bosscher@student.tudelft.nl>
@@ -5069,6 +5069,18 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
 
   gfc_add_expr_to_block (&se->pre, tmp);
 
+  if (expr->ts.type == BT_CLASS && expr3)
+    {
+      tmp = build_int_cst (unsigned_char_type_node, 0);
+      /* For class objects we need to nullify the memory in case they have
+	 allocatable components; the reason is that _copy, which is used for
+	 initialization, first frees the destination.  */
+      tmp = build_call_expr_loc (input_location,
+				 builtin_decl_explicit (BUILT_IN_MEMSET),
+				 3, pointer, tmp,  size);
+      gfc_add_expr_to_block (&se->pre, tmp);
+    }
+
   /* Update the array descriptors. */
   if (dimension)
     gfc_conv_descriptor_offset_set (&set_descriptor_block, se->expr, offset);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 83d8087..2ffa9fc 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1,6 +1,6 @@
 /* Expression translation
    Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
-   2011
+   2011, 2012
    Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
    and Steven Bosscher <s.bosscher@student.tudelft.nl>
@@ -302,6 +302,179 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e,
   parmse->expr = gfc_build_addr_expr (NULL_TREE, var);
 }
 
+
+static tree
+gfc_trans_class_array_init_assign (gfc_expr *rhs, gfc_expr *lhs, gfc_expr *obj)
+{
+  gfc_actual_arglist *actual;
+  gfc_expr *ppc;
+  gfc_code *ppc_code;
+  tree res;
+
+  actual = gfc_get_actual_arglist ();
+  actual->expr = gfc_copy_expr (rhs);
+  actual->next = gfc_get_actual_arglist ();
+  actual->next->expr = gfc_copy_expr (lhs);
+  ppc = gfc_copy_expr (obj);
+  gfc_add_vptr_component (ppc);
+  gfc_add_component_ref (ppc, "_copy");
+  ppc_code = gfc_get_code ();
+  ppc_code->resolved_sym = ppc->symtree->n.sym;
+  /* Although '_copy' is set to be elemental in class.c, it is
+     not staying that way.  Find out why, sometime....  */
+  ppc_code->resolved_sym->attr.elemental = 1;
+  ppc_code->ext.actual = actual;
+  ppc_code->expr1 = ppc;
+  ppc_code->op = EXEC_CALL;
+  /* Since '_copy' is elemental, the scalarizer will take care
+     of arrays in gfc_trans_call.  */
+  res = gfc_trans_call (ppc_code, false, NULL, NULL, false);
+  gfc_free_statements (ppc_code);
+  return res;
+}
+
+/* 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;
+  gfc_se dst,src,memsz;
+  gfc_expr *lhs, *rhs, *sz;
+
+  gfc_start_block (&block);
+
+  lhs = gfc_copy_expr (code->expr1);
+  gfc_add_data_component (lhs);
+
+  rhs = gfc_copy_expr (code->expr1);
+  gfc_add_vptr_component (rhs);
+
+  /* Make sure that the component backend_decls have been built, which
+     will not have happened if the derived types concerned have not
+     been referenced.  */
+  gfc_get_derived_type (rhs->ts.u.derived);
+  gfc_add_def_init_component (rhs);
+
+  if (code->expr1->ts.type == BT_CLASS
+	&& CLASS_DATA (code->expr1)->attr.dimension)
+    tmp = gfc_trans_class_array_init_assign (rhs, lhs, code->expr1);
+  else
+    {
+      sz = gfc_copy_expr (code->expr1);
+      gfc_add_vptr_component (sz);
+      gfc_add_size_component (sz);
+
+      gfc_init_se (&dst, NULL);
+      gfc_init_se (&src, NULL);
+      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);
+      tmp = gfc_build_memcpy_call (dst.expr, src.expr, memsz.expr);
+    }
+  gfc_add_expr_to_block (&block, tmp);
+  
+  return gfc_finish_block (&block);
+}
+
+
+/* Translate an assignment to a CLASS object
+   (pointer or ordinary assignment).  */
+
+tree
+gfc_trans_class_assign (gfc_expr *expr1, gfc_expr *expr2, gfc_exec_op op)
+{
+  stmtblock_t block;
+  tree tmp;
+  gfc_expr *lhs;
+  gfc_expr *rhs;
+  gfc_ref *ref;
+
+  gfc_start_block (&block);
+
+  ref = expr1->ref;
+  while (ref && ref->next)
+     ref = ref->next;
+
+  /* Class valued proc_pointer assignments do not need any further
+     preparation.  */
+  if (ref && ref->type == REF_COMPONENT
+	&& ref->u.c.component->attr.proc_pointer
+	&& expr2->expr_type == EXPR_VARIABLE
+	&& expr2->symtree->n.sym->attr.flavor == FL_PROCEDURE
+	&& op == EXEC_POINTER_ASSIGN)
+    goto assign;
+
+  if (expr2->ts.type != BT_CLASS)
+    {
+      /* Insert an additional assignment which sets the '_vptr' field.  */
+      gfc_symbol *vtab = NULL;
+      gfc_symtree *st;
+
+      lhs = gfc_copy_expr (expr1);
+      gfc_add_vptr_component (lhs);
+
+      if (expr2->ts.type == BT_DERIVED)
+	vtab = gfc_find_derived_vtab (expr2->ts.u.derived);
+      else if (expr2->expr_type == EXPR_NULL)
+	vtab = gfc_find_derived_vtab (expr1->ts.u.derived);
+      gcc_assert (vtab);
+
+      rhs = gfc_get_expr ();
+      rhs->expr_type = EXPR_VARIABLE;
+      gfc_find_sym_tree (vtab->name, vtab->ns, 1, &st);
+      rhs->symtree = st;
+      rhs->ts = vtab->ts;
+
+      tmp = gfc_trans_pointer_assignment (lhs, rhs);
+      gfc_add_expr_to_block (&block, tmp);
+
+      gfc_free_expr (lhs);
+      gfc_free_expr (rhs);
+    }
+  else if (CLASS_DATA (expr2)->attr.dimension)
+    {
+      /* Insert an additional assignment which sets the '_vptr' field.  */
+      lhs = gfc_copy_expr (expr1);
+      gfc_add_vptr_component (lhs);
+
+      rhs = gfc_copy_expr (expr2);
+      gfc_add_vptr_component (rhs);
+
+      tmp = gfc_trans_pointer_assignment (lhs, rhs);
+      gfc_add_expr_to_block (&block, tmp);
+
+      gfc_free_expr (lhs);
+      gfc_free_expr (rhs);
+    }
+
+  /* Do the actual CLASS assignment.  */
+  if (expr2->ts.type == BT_CLASS
+	&& !CLASS_DATA (expr2)->attr.dimension)
+    op = EXEC_ASSIGN;
+  else
+    gfc_add_data_component (expr1);
+
+assign:
+
+  if (op == EXEC_ASSIGN)
+    tmp = gfc_trans_assignment (expr1, expr2, false, true);
+  else if (op == EXEC_POINTER_ASSIGN)
+    tmp = gfc_trans_pointer_assignment (expr1, expr2);
+  else
+    gcc_unreachable();
+
+  gfc_add_expr_to_block (&block, tmp);
+
+  return gfc_finish_block (&block);
+}
+
+
 /* End of prototype trans-class.c  */
 
 
@@ -1976,6 +2149,31 @@ get_proc_ptr_comp (gfc_expr *e)
 }
 
 
+/* Convert a typebound function reference from a class object.  */
+static void
+conv_base_obj_fcn_val (gfc_se * se, tree base_object, gfc_expr * expr)
+{
+  gfc_ref *ref;
+  tree var;
+
+  if (TREE_CODE (base_object) != VAR_DECL)
+    {
+      var = gfc_create_var (TREE_TYPE (base_object), NULL);
+      gfc_add_modify (&se->pre, var, base_object);
+    }
+  se->expr = gfc_class_vptr_get (base_object);
+  se->expr = build_fold_indirect_ref_loc (input_location, se->expr);
+  ref = expr->ref;
+  while (ref && ref->next)
+    ref = ref->next;
+  gcc_assert (ref && ref->type == REF_COMPONENT);
+  if (ref->u.c.sym->attr.extension)
+    conv_parent_component_references (se, ref);
+  gfc_conv_component_ref (se, ref);
+  se->expr = build_fold_addr_expr_loc (input_location, se->expr);
+}
+
+
 static void
 conv_function_val (gfc_se * se, gfc_symbol * sym, gfc_expr * expr)
 {
@@ -3084,6 +3282,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
   tree type;
   tree var;
   tree len;
+  tree base_object;
   VEC(tree,gc) *stringargs;
   tree result = NULL;
   gfc_formal_arglist *formal;
@@ -3156,6 +3355,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 				   != EXPR_CONSTANT);
     }
 
+  base_object = NULL_TREE;
+
   /* Evaluate the arguments.  */
   for (arg = args; arg != NULL;
        arg = arg->next, formal = formal ? formal->next : NULL)
@@ -3301,6 +3502,13 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		{
 		  gfc_conv_expr_reference (&parmse, e);
 
+		  /* Catch base objects that are not variables.  */
+		  if (e->ts.type == BT_CLASS
+			&& e->expr_type != EXPR_VARIABLE
+			&& expr && e == expr->base_expr)
+		    base_object = build_fold_indirect_ref_loc (input_location,
+							       parmse.expr);
+
 		  /* A class array element needs converting back to be a
 		     class object, if the formal argument is a class object.  */
 		  if (fsym && fsym->ts.type == BT_CLASS
@@ -4000,7 +4208,10 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
   arglist = retargs;
 
   /* Generate the actual call.  */
-  conv_function_val (se, sym, expr);
+  if (base_object == NULL_TREE)
+    conv_function_val (se, sym, expr);
+  else
+    conv_base_obj_fcn_val (se, base_object, expr);
 
   /* If there are alternate return labels, function type should be
      integer.  Can't modify the type in place though, since it can be shared
@@ -5294,7 +5505,6 @@ gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr)
       return;
     }
 
-
   gfc_conv_expr (se, expr);
 
   /* Create a temporary var to hold the value.  */
@@ -6730,158 +6940,3 @@ gfc_trans_assign (gfc_code * code)
 {
   return gfc_trans_assignment (code->expr1, code->expr2, false, true);
 }
-
-
-static tree
-gfc_trans_class_array_init_assign (gfc_expr *rhs, gfc_expr *lhs, gfc_expr *obj)
-{
-  gfc_actual_arglist *actual;
-  gfc_expr *ppc;
-  gfc_code *ppc_code;
-  tree res;
-
-  actual = gfc_get_actual_arglist ();
-  actual->expr = gfc_copy_expr (rhs);
-  actual->next = gfc_get_actual_arglist ();
-  actual->next->expr = gfc_copy_expr (lhs);
-  ppc = gfc_copy_expr (obj);
-  gfc_add_vptr_component (ppc);
-  gfc_add_component_ref (ppc, "_copy");
-  ppc_code = gfc_get_code ();
-  ppc_code->resolved_sym = ppc->symtree->n.sym;
-  /* Although '_copy' is set to be elemental in class.c, it is
-     not staying that way.  Find out why, sometime....  */
-  ppc_code->resolved_sym->attr.elemental = 1;
-  ppc_code->ext.actual = actual;
-  ppc_code->expr1 = ppc;
-  ppc_code->op = EXEC_CALL;
-  /* Since '_copy' is elemental, the scalarizer will take care
-     of arrays in gfc_trans_call.  */
-  res = gfc_trans_call (ppc_code, false, NULL, NULL, false);
-  gfc_free_statements (ppc_code);
-  return res;
-}
-
-/* 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;
-  gfc_se dst,src,memsz;
-  gfc_expr *lhs,*rhs,*sz;
-
-  gfc_start_block (&block);
-
-  lhs = gfc_copy_expr (code->expr1);
-  gfc_add_data_component (lhs);
-
-  rhs = gfc_copy_expr (code->expr1);
-  gfc_add_vptr_component (rhs);
-
-  /* Make sure that the component backend_decls have been built, which
-     will not have happened if the derived types concerned have not
-     been referenced.  */
-  gfc_get_derived_type (rhs->ts.u.derived);
-  gfc_add_def_init_component (rhs);
-
-  if (code->expr1->ts.type == BT_CLASS
-	&& CLASS_DATA (code->expr1)->attr.dimension)
-    tmp = gfc_trans_class_array_init_assign (rhs, lhs, code->expr1);
-  else
-    {
-      sz = gfc_copy_expr (code->expr1);
-      gfc_add_vptr_component (sz);
-      gfc_add_size_component (sz);
-
-      gfc_init_se (&dst, NULL);
-      gfc_init_se (&src, NULL);
-      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);
-      tmp = gfc_build_memcpy_call (dst.expr, src.expr, memsz.expr);
-    }
-  gfc_add_expr_to_block (&block, tmp);
-  
-  return gfc_finish_block (&block);
-}
-
-
-/* Translate an assignment to a CLASS object
-   (pointer or ordinary assignment).  */
-
-tree
-gfc_trans_class_assign (gfc_expr *expr1, gfc_expr *expr2, gfc_exec_op op)
-{
-  stmtblock_t block;
-  tree tmp;
-  gfc_expr *lhs;
-  gfc_expr *rhs;
-
-  gfc_start_block (&block);
-
-  if (expr2->ts.type != BT_CLASS)
-    {
-      /* Insert an additional assignment which sets the '_vptr' field.  */
-      gfc_symbol *vtab = NULL;
-      gfc_symtree *st;
-
-      lhs = gfc_copy_expr (expr1);
-      gfc_add_vptr_component (lhs);
-
-      if (expr2->ts.type == BT_DERIVED)
-	vtab = gfc_find_derived_vtab (expr2->ts.u.derived);
-      else if (expr2->expr_type == EXPR_NULL)
-	vtab = gfc_find_derived_vtab (expr1->ts.u.derived);
-      gcc_assert (vtab);
-
-      rhs = gfc_get_expr ();
-      rhs->expr_type = EXPR_VARIABLE;
-      gfc_find_sym_tree (vtab->name, vtab->ns, 1, &st);
-      rhs->symtree = st;
-      rhs->ts = vtab->ts;
-
-      tmp = gfc_trans_pointer_assignment (lhs, rhs);
-      gfc_add_expr_to_block (&block, tmp);
-
-      gfc_free_expr (lhs);
-      gfc_free_expr (rhs);
-    }
-  else if (CLASS_DATA (expr2)->attr.dimension)
-    {
-      /* Insert an additional assignment which sets the '_vptr' field.  */
-      lhs = gfc_copy_expr (expr1);
-      gfc_add_vptr_component (lhs);
-
-      rhs = gfc_copy_expr (expr2);
-      gfc_add_vptr_component (rhs);
-
-      tmp = gfc_trans_pointer_assignment (lhs, rhs);
-      gfc_add_expr_to_block (&block, tmp);
-
-      gfc_free_expr (lhs);
-      gfc_free_expr (rhs);
-    }
-
-  /* Do the actual CLASS assignment.  */
-  if (expr2->ts.type == BT_CLASS && !CLASS_DATA (expr2)->attr.dimension)
-    op = EXEC_ASSIGN;
-  else
-    gfc_add_data_component (expr1);
-
-  if (op == EXEC_ASSIGN)
-    tmp = gfc_trans_assignment (expr1, expr2, false, true);
-  else if (op == EXEC_POINTER_ASSIGN)
-    tmp = gfc_trans_pointer_assignment (expr1, expr2);
-  else
-    gcc_unreachable();
-
-  gfc_add_expr_to_block (&block, tmp);
-
-  return gfc_finish_block (&block);
-}