re PR fortran/45271 ([OOP] Polymorphic code breaks when changing order of USE statements)

2010-08-21  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/45271
	PR fortran/45290
	* class.c (add_proc_comp): Add static initializer for PPCs.
	(add_procs_to_declared_vtab): Modified comment.
	* module.c (mio_component): Add argument 'vtype'. Don't read/write the
	initializer if the component is part of a vtype.
	(mio_component_list): Add argument 'vtype', pass it on to
	'mio_component'.
	(mio_symbol): Modified call to 'mio_component_list'.
	* trans.h (gfc_conv_initializer): Modified prototype.
	(gfc_trans_assign_vtab_procs): Removed.
	* trans-common.c (create_common): Modified call to
	'gfc_conv_initializer'.
	* trans-decl.c (gfc_get_symbol_decl,get_proc_pointer_decl,
	gfc_emit_parameter_debug_info): Modified call to
	'gfc_conv_initializer'.
	(build_function_decl): Remove assertion.
	* trans-expr.c (gfc_conv_derived_to_class,gfc_trans_class_assign):
	Removed call to 'gfc_trans_assign_vtab_procs'.
	(gfc_conv_initializer): Add argument 'procptr'.
	(gfc_conv_structure): Modified call to 'gfc_conv_initializer'.
	(gfc_trans_assign_vtab_procs): Removed.
	* trans-stmt.c (gfc_trans_allocate): Removed call to
	'gfc_trans_assign_vtab_procs'.


2010-08-21  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/44863
	PR fortran/45271
	PR fortran/45290
	* gfortran.dg/dynamic_dispatch_10.f03: New (PR 44863 comment #1).
	* gfortran.dg/pointer_init_5.f90: New (PR 45290 comment #6).
	* gfortran.dg/typebound_call_18.f03: New (PR 45271 comment #3).

From-SVN: r163445

1 files changed, 7 insertions, 65 deletions

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index f7badd7..103bc24 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2574,7 +2574,6 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
      not to the class declared type.  */
   vtab = gfc_find_derived_vtab (e->ts.u.derived);
   gcc_assert (vtab);
-  gfc_trans_assign_vtab_procs (&parmse->pre, e->ts.u.derived, vtab);
   tmp = gfc_build_addr_expr (NULL_TREE, gfc_get_symbol_decl (vtab));
   gfc_add_modify (&parmse->pre, ctree,
 		  fold_convert (TREE_TYPE (ctree), tmp));
@@ -3946,11 +3945,11 @@ gfc_conv_array_constructor_expr (gfc_se * se, gfc_expr * expr)
 
 tree
 gfc_conv_initializer (gfc_expr * expr, gfc_typespec * ts, tree type,
-		      bool array, bool pointer)
+		      bool array, bool pointer, bool procptr)
 {
   gfc_se se;
 
-  if (!(expr || pointer))
+  if (!(expr || pointer || procptr))
     return NULL_TREE;
 
   /* Check if we have ISOCBINDING_NULL_PTR or ISOCBINDING_NULL_FUNPTR
@@ -3972,7 +3971,7 @@ gfc_conv_initializer (gfc_expr * expr, gfc_typespec * ts, tree type,
       return se.expr;
     }
   
-  if (array)
+  if (array && !procptr)
     {
       /* Arrays need special handling.  */
       if (pointer)
@@ -3983,7 +3982,7 @@ gfc_conv_initializer (gfc_expr * expr, gfc_typespec * ts, tree type,
       else
 	return gfc_conv_array_initializer (type, expr);
     }
-  else if (pointer)
+  else if (pointer || procptr)
     {
       if (!expr || expr->expr_type == EXPR_NULL)
 	return fold_convert (type, null_pointer_node);
@@ -4462,8 +4461,9 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init)
       else
 	{
 	  val = gfc_conv_initializer (c->expr, &cm->ts,
-	      TREE_TYPE (cm->backend_decl), cm->attr.dimension,
-	      cm->attr.pointer || cm->attr.proc_pointer);
+				      TREE_TYPE (cm->backend_decl),
+				      cm->attr.dimension, cm->attr.pointer,
+				      cm->attr.proc_pointer);
 
 	  /* Append it to the constructor list.  */
 	  CONSTRUCTOR_APPEND_ELT (v, cm->backend_decl, val);
@@ -5779,63 +5779,6 @@ gfc_trans_assign (gfc_code * code)
 }
 
 
-/* Generate code to assign typebound procedures to a derived vtab.  */
-void gfc_trans_assign_vtab_procs (stmtblock_t *block, gfc_symbol *dt,
-				  gfc_symbol *vtab)
-{
-  gfc_component *cmp;
-  tree vtb, ctree, proc, cond = NULL_TREE;
-  stmtblock_t body;
-
-  /* Point to the first procedure pointer.  */
-  cmp = gfc_find_component (vtab->ts.u.derived, "$extends", true, true);
-  cmp = cmp->next;
-  if (!cmp)
-    return;
-  
-  vtb = gfc_get_symbol_decl (vtab);
-
-  ctree = fold_build3 (COMPONENT_REF, TREE_TYPE (cmp->backend_decl), vtb,
-		       cmp->backend_decl, NULL_TREE);
-  cond = fold_build2 (EQ_EXPR, boolean_type_node, ctree,
-		      build_int_cst (TREE_TYPE (ctree), 0));
-
-  gfc_init_block (&body);
-  for (; cmp; cmp = cmp->next)
-    {
-      gfc_symbol *target = NULL;
-
-      /* This is required when typebound generic procedures are called
-	 with derived type targets.  The specific procedures do not get
-	 added to the vtype, which remains "empty".  */
-      if (cmp->tb && cmp->tb->u.specific && cmp->tb->u.specific->n.sym)
-	target = cmp->tb->u.specific->n.sym;
-      else
-	{
-	  gfc_symtree *st;
-	  st = gfc_find_typebound_proc (dt, NULL, cmp->name, false, NULL);
-	  if (st->n.tb && st->n.tb->u.specific)
-	    target = st->n.tb->u.specific->n.sym;
-	}
-
-      if (!target)
-	continue;
-
-      ctree = fold_build3 (COMPONENT_REF, TREE_TYPE (cmp->backend_decl),
-			   vtb, cmp->backend_decl, NULL_TREE);
-      proc = gfc_get_symbol_decl (target);
-      proc = gfc_build_addr_expr (TREE_TYPE (ctree), proc);
-      gfc_add_modify (&body, ctree, proc);
-    }
-
-  proc = gfc_finish_block (&body);
-
-  proc = build3_v (COND_EXPR, cond, proc, build_empty_stmt (input_location));
-
-  gfc_add_expr_to_block (block, proc);
-}
-
-
 /* 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.  */
@@ -5887,7 +5830,6 @@ gfc_trans_class_assign (gfc_expr *expr1, gfc_expr *expr2, gfc_exec_op op)
 	  gfc_symtree *st;
 	  vtab = gfc_find_derived_vtab (expr2->ts.u.derived);
 	  gcc_assert (vtab);
-	  gfc_trans_assign_vtab_procs (&block, expr2->ts.u.derived, vtab);
 	  rhs = gfc_get_expr ();
 	  rhs->expr_type = EXPR_VARIABLE;
 	  gfc_find_sym_tree (vtab->name, NULL, 1, &st);