From 88ce80316fbb4d001f08eb4c65dbb7ae88e0474f Mon Sep 17 00:00:00 2001
From: Janus Weil <janus@gcc.gnu.org>
Date: Tue, 13 Jul 2010 08:57:17 +0200
Subject: [PATCH] re PR fortran/44434 ([OOP] ICE in in gfc_add_component_ref)

2010-07-13  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/44434
	PR fortran/44565
	PR fortran/43945
	PR fortran/44869
	* gfortran.h (gfc_find_derived_vtab): Modified prototype.
	* class.c (gfc_build_class_symbol): Modified call to
	'gfc_find_derived_vtab'.
	(add_proc_component): Removed, moved code into 'add_proc_comp'.
	(add_proc_comps): Renamed to 'add_proc_comp', removed treatment of
	generics.
	(add_procs_to_declared_vtab1): Removed unnecessary argument 'resolved'.
	Removed treatment of generics.
	(copy_vtab_proc_comps): Removed unnecessary argument 'resolved'.
	Call 'add_proc_comp' instead of duplicating code.
	(add_procs_to_declared_vtab): Removed unnecessary arguments 'resolved'
	and 'declared'.
	(add_generic_specifics,add_generics_to_declared_vtab): Removed.
	(gfc_find_derived_vtab): Removed unnecessary argument 'resolved'.
	Removed treatment of generics.
	* iresolve.c (gfc_resolve_extends_type_of): Modified call to
	'gfc_find_derived_vtab'.
	* resolve.c (resolve_typebound_function,resolve_typebound_subroutine):
	Removed treatment of generics.
	(resolve_select_type,resolve_fl_derived): Modified call to
	'gfc_find_derived_vtab'.
	* trans-decl.c (gfc_get_symbol_decl): Ditto.
	* trans-expr.c (gfc_conv_derived_to_class,gfc_trans_class_assign):
	Ditto.
	* trans-stmt.c (gfc_trans_allocate): Ditto.

2010-07-13  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/44434
	PR fortran/44565
	PR fortran/43945
	PR fortran/44869
	* gfortran.dg/dynamic_dispatch_1.f03: Fixed invalid test case.
	* gfortran.dg/dynamic_dispatch_2.f03: Ditto.
	* gfortran.dg/dynamic_dispatch_3.f03: Ditto.
	* gfortran.dh/typebound_call_16.f03: New.
	* gfortran.dg/typebound_generic_6.f03: New.
	* gfortran.dg/typebound_generic_7.f03: New.
	* gfortran.dg/typebound_generic_8.f03: New.

From-SVN: r162125
---
 gcc/fortran/ChangeLog                         |  32 ++
 gcc/fortran/class.c                           | 359 ++++--------------
 gcc/fortran/gfortran.h                        |   2 +-
 gcc/fortran/iresolve.c                        |   4 +-
 gcc/fortran/resolve.c                         |  34 +-
 gcc/fortran/trans-decl.c                      |   2 +-
 gcc/fortran/trans-expr.c                      |   6 +-
 gcc/fortran/trans-stmt.c                      |   2 +-
 gcc/testsuite/ChangeLog                       |  14 +
 .../gfortran.dg/dynamic_dispatch_1.f03        |   7 +-
 .../gfortran.dg/dynamic_dispatch_2.f03        |  10 +-
 .../gfortran.dg/dynamic_dispatch_3.f03        |   7 +-
 .../gfortran.dg/typebound_call_16.f03         |  35 ++
 .../gfortran.dg/typebound_generic_6.f03       |  69 ++++
 .../gfortran.dg/typebound_generic_7.f03       |  28 ++
 .../gfortran.dg/typebound_generic_8.f03       |  29 ++
 16 files changed, 286 insertions(+), 354 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/typebound_call_16.f03
 create mode 100644 gcc/testsuite/gfortran.dg/typebound_generic_6.f03
 create mode 100644 gcc/testsuite/gfortran.dg/typebound_generic_7.f03
 create mode 100644 gcc/testsuite/gfortran.dg/typebound_generic_8.f03

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 25b34f21849..b4a6f1b9f3b 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,35 @@
+2010-07-13  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44434
+	PR fortran/44565
+	PR fortran/43945
+	PR fortran/44869
+	* gfortran.h (gfc_find_derived_vtab): Modified prototype.
+	* class.c (gfc_build_class_symbol): Modified call to
+	'gfc_find_derived_vtab'.
+	(add_proc_component): Removed, moved code into 'add_proc_comp'.
+	(add_proc_comps): Renamed to 'add_proc_comp', removed treatment of
+	generics.
+	(add_procs_to_declared_vtab1): Removed unnecessary argument 'resolved'.
+	Removed treatment of generics.
+	(copy_vtab_proc_comps): Removed unnecessary argument 'resolved'.
+	Call 'add_proc_comp' instead of duplicating code.
+	(add_procs_to_declared_vtab): Removed unnecessary arguments 'resolved'
+	and 'declared'.
+	(add_generic_specifics,add_generics_to_declared_vtab): Removed.
+	(gfc_find_derived_vtab): Removed unnecessary argument 'resolved'.
+	Removed treatment of generics.
+	* iresolve.c (gfc_resolve_extends_type_of): Modified call to
+	'gfc_find_derived_vtab'.
+	* resolve.c (resolve_typebound_function,resolve_typebound_subroutine):
+	Removed treatment of generics.
+	(resolve_select_type,resolve_fl_derived): Modified call to
+	'gfc_find_derived_vtab'.
+	* trans-decl.c (gfc_get_symbol_decl): Ditto.
+	* trans-expr.c (gfc_conv_derived_to_class,gfc_trans_class_assign):
+	Ditto.
+	* trans-stmt.c (gfc_trans_allocate): Ditto.
+
 2010-07-12  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR fortran/37077
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 37b9cf01590..b5e17f4e2f6 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -174,7 +174,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
 	c->ts.u.derived = NULL;
       else
 	{
-	  vtab = gfc_find_derived_vtab (ts->u.derived, false);
+	  vtab = gfc_find_derived_vtab (ts->u.derived);
 	  gcc_assert (vtab);
 	  c->ts.u.derived = vtab->ts.u.derived;
 	}
@@ -199,344 +199,126 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
 }
 
 
+/* Add a procedure pointer component to the vtype
+   to represent a specific type-bound procedure.  */
+
 static void
-add_proc_component (gfc_component *c, gfc_symbol *vtype,
-		    gfc_symtree *st, gfc_symbol *specific,
-		    bool is_generic, bool is_generic_specific)
+add_proc_comp (gfc_symbol *vtype, const char *name, gfc_typebound_proc *tb)
 {
-  /* Add procedure component.  */
-  if (is_generic)
-    {
-      if (gfc_add_component (vtype, specific->name, &c) == FAILURE)
-	return;
-      c->ts.interface = specific;
-    }
-  else if (c && is_generic_specific)
-    {
-      c->ts.interface = st->n.tb->u.specific->n.sym;
-    }
-  else
+  gfc_component *c;
+  c = gfc_find_component (vtype, name, true, true);
+
+  if (c == NULL)
     {
-      c = gfc_find_component (vtype, st->name, true, true);
-      if (!c && gfc_add_component (vtype, st->name, &c) == FAILURE)
+      /* Add procedure component.  */
+      if (gfc_add_component (vtype, name, &c) == FAILURE)
 	return;
-      c->ts.interface = st->n.tb->u.specific->n.sym;
-    }
-
-  if (!c->tb)
-    c->tb = XCNEW (gfc_typebound_proc);
-  *c->tb = *st->n.tb;
-  c->tb->ppc = 1;
-  c->attr.procedure = 1;
-  c->attr.proc_pointer = 1;
-  c->attr.flavor = FL_PROCEDURE;
-  c->attr.access = ACCESS_PRIVATE;
-  c->attr.external = 1;
-  c->attr.untyped = 1;
-  c->attr.if_source = IFSRC_IFBODY;
-
-  /* A static initializer cannot be used here because the specific
-     function is not a constant; internal compiler error: in
-     output_constant, at varasm.c:4623  */
-  c->initializer = NULL;
-}
+      if (tb->u.specific)
+	c->ts.interface = tb->u.specific->n.sym;
 
+      if (!c->tb)
+	c->tb = XCNEW (gfc_typebound_proc);
+      *c->tb = *tb;
+      c->tb->ppc = 1;
+      c->attr.procedure = 1;
+      c->attr.proc_pointer = 1;
+      c->attr.flavor = FL_PROCEDURE;
+      c->attr.access = ACCESS_PRIVATE;
+      c->attr.external = 1;
+      c->attr.untyped = 1;
+      c->attr.if_source = IFSRC_IFBODY;
 
-static void
-add_proc_comps (gfc_component *c, gfc_symbol *vtype,
-		gfc_symtree *st, bool is_generic)
-{
-  if (c == NULL && !is_generic)
-    {
-      add_proc_component (c, vtype, st, NULL, false, false);
-    }
-  else if (is_generic && st->n.tb && vtype->components == NULL)
-    {
-      gfc_tbp_generic* g;
-      gfc_symbol * specific;
-      for (g = st->n.tb->u.generic; g; g = g->next)
-	{
-	  if (!g->specific)
-	    continue;
-	  specific = g->specific->u.specific->n.sym;
-	  add_proc_component (NULL, vtype, st, specific, true, false);
-	}
+      /* A static initializer cannot be used here because the specific
+	function is not a constant; internal compiler error: in
+	output_constant, at varasm.c:4623  */
+      c->initializer = NULL;
     }
   else if (c->attr.proc_pointer && c->tb)
     {
-      *c->tb = *st->n.tb;
+      *c->tb = *tb;
       c->tb->ppc = 1;
-      c->ts.interface = st->n.tb->u.specific->n.sym;	  
+      c->ts.interface = tb->u.specific->n.sym;	  
     }
 }
 
+
+/* Add all specific type-bound procedures in the symtree 'st' to a vtype.  */
+
 static void
-add_procs_to_declared_vtab1 (gfc_symtree *st, gfc_symbol *vtype,
-			     bool resolved)
+add_procs_to_declared_vtab1 (gfc_symtree *st, gfc_symbol *vtype)
 {
-  gfc_component *c;
-  gfc_symbol *generic;
-  char name[3 * GFC_MAX_SYMBOL_LEN + 10];
-
   if (!st)
     return;
 
   if (st->left)
-    add_procs_to_declared_vtab1 (st->left, vtype, resolved);
+    add_procs_to_declared_vtab1 (st->left, vtype);
 
   if (st->right)
-    add_procs_to_declared_vtab1 (st->right, vtype, resolved);
+    add_procs_to_declared_vtab1 (st->right, vtype);
 
   if (!st->n.tb)
     return;
 
   if (!st->n.tb->is_generic && st->n.tb->u.specific)
-    {
-      c = gfc_find_component (vtype, st->name, true, true);
-      add_proc_comps (c, vtype, st, false);
-    }
-  else if (st->n.tb->is_generic)
-    {
-      c = gfc_find_component (vtype, st->name, true, true);
-
-      if (c == NULL)
-	{
-	  /* Add derived type component with generic name.  */
-	  if (gfc_add_component (vtype, st->name, &c) == FAILURE)
-	    return;
-	  c->ts.type = BT_DERIVED;
-	  c->attr.flavor = FL_VARIABLE;
-	  c->attr.pointer = 1;
-
-	  /* Add a special empty derived type as a placeholder.  */
-	  sprintf (name, "$empty");
-	  gfc_find_symbol (name, vtype->ns, 0, &generic);
-	  if (generic == NULL)
-	    {
-	      gfc_get_symbol (name, vtype->ns, &generic);
-	      generic->attr.flavor = FL_DERIVED;
-	      generic->refs++;
-	      gfc_set_sym_referenced (generic);
-	      generic->ts.type = BT_UNKNOWN;
-	      generic->attr.zero_comp = 1;
-	    }
-
-	  c->ts.u.derived = generic;
-	}
-    }
+    add_proc_comp (vtype, st->name, st->n.tb);
 }
 
 
+/* Copy procedure pointers components from the parent type.  */
+
 static void
-copy_vtab_proc_comps (gfc_symbol *declared, gfc_symbol *vtype,
-		      bool resolved)
+copy_vtab_proc_comps (gfc_symbol *declared, gfc_symbol *vtype)
 {
-  gfc_component *c, *cmp;
+  gfc_component *cmp;
   gfc_symbol *vtab;
 
-  vtab = gfc_find_derived_vtab (declared, resolved);
+  vtab = gfc_find_derived_vtab (declared);
 
   for (cmp = vtab->ts.u.derived->components; cmp; cmp = cmp->next)
     {
       if (gfc_find_component (vtype, cmp->name, true, true))
 	continue;
 
-      if (gfc_add_component (vtype, cmp->name, &c) == FAILURE)
-	return;
-
-      if (cmp->ts.type == BT_DERIVED)
-	{
-	  c->ts = cmp->ts;
-	  c->ts.u.derived = cmp->ts.u.derived;
-	  c->attr.flavor = FL_VARIABLE;
-	  c->attr.pointer = 1;
-	  c->initializer = NULL;
-	  continue;
-	}
-
-      c->tb = XCNEW (gfc_typebound_proc);
-      *c->tb = *cmp->tb;
-      c->attr.procedure = 1;
-      c->attr.proc_pointer = 1;
-      c->attr.flavor = FL_PROCEDURE;
-      c->attr.access = ACCESS_PRIVATE;
-      c->attr.external = 1;
-      c->ts.interface = cmp->ts.interface;
-      c->attr.untyped = 1;
-      c->attr.if_source = IFSRC_IFBODY;
-      c->initializer = NULL;
+      add_proc_comp (vtype, cmp->name, cmp->tb);
     }
 }
 
-static void
-add_procs_to_declared_vtab (gfc_symbol *declared, gfc_symbol *vtype,
-			    gfc_symbol *derived, bool resolved)
-{
-  gfc_symbol* super_type;
-
-  super_type = gfc_get_derived_super_type (declared);
-
-  if (super_type && (super_type != declared))
-    add_procs_to_declared_vtab (super_type, vtype, derived, resolved);
-
-  if (declared != derived)
-    copy_vtab_proc_comps (declared, vtype, resolved);
-
-  if (declared->f2k_derived && declared->f2k_derived->tb_sym_root)
-    add_procs_to_declared_vtab1 (declared->f2k_derived->tb_sym_root,
-				 vtype, resolved);
-
-  if (declared->f2k_derived && declared->f2k_derived->tb_uop_root)
-    add_procs_to_declared_vtab1 (declared->f2k_derived->tb_uop_root,
-				 vtype, resolved);
-}
-
-
-static
-void add_generic_specifics (gfc_symbol *declared, gfc_symbol *vtab,
-			    const char *name)
-{
-  gfc_tbp_generic* g;
-  gfc_symbol * specific1;
-  gfc_symbol * specific2;
-  gfc_symtree *st = NULL;
-  gfc_component *c;
-
-  /* Find the generic procedure using the component name.  */
-  st = gfc_find_typebound_proc (declared, NULL, name, true, NULL);
-  if (st == NULL)
-    st = gfc_find_typebound_user_op (declared, NULL, name, true, NULL);
-
-  if (st == NULL)
-    return;
-
-  /* Add procedure pointer components for the specific procedures. */
-  for (g = st->n.tb->u.generic; g; g = g->next)
-    {
-      if (!g->specific)
-	continue;
-      specific1 = g->specific_st->n.tb->u.specific->n.sym;
-
-      c = vtab->ts.u.derived->components;
-      specific2 = NULL;
-
-      /* Override identical specific interface.  */
-      if (vtab->ts.u.derived->components)
-	{
-	  for (; c; c= c->next)
-	    {
-	      specific2 = c->ts.interface;
-	      if (gfc_compare_interfaces (specific2, specific1,
-					  specific1->name, 0, 0, NULL, 0))
-		break;
-	    }
-	}
-
-      add_proc_component (c, vtab->ts.u.derived, g->specific_st,
-			  NULL, false, true);
-      vtab->ts.u.derived->attr.zero_comp = 0;
-    }
-}
 
+/* Add procedure pointers for all type-bound procedures to a vtab.  */
 
 static void
-add_generics_to_declared_vtab (gfc_symbol *declared, gfc_symbol *vtype,
-			       gfc_symbol *derived, bool resolved)
+add_procs_to_declared_vtab (gfc_symbol *derived, gfc_symbol *vtype)
 {
-  gfc_component *cmp;
-  gfc_symtree *st = NULL;
-  gfc_symbol * vtab;
-  char name[2 * GFC_MAX_SYMBOL_LEN + 8];
   gfc_symbol* super_type;
 
-  gcc_assert (resolved);
+  super_type = gfc_get_derived_super_type (derived);
 
-  for (cmp = vtype->components; cmp; cmp = cmp->next)
+  if (super_type && (super_type != derived))
     {
-      if (cmp->ts.type != BT_DERIVED)
-	continue;
-
-      /* The only derived type that does not represent a generic
-	 procedure is the pointer to the parent vtab.  */
-      if (cmp->ts.u.derived
-	    && strcmp (cmp->ts.u.derived->name, "$extends") == 0)
-	continue;
-
-      /* Find the generic procedure using the component name.  */
-      st = gfc_find_typebound_proc (declared, NULL, cmp->name,
-				    true, NULL);
-      if (st == NULL)
-	st = gfc_find_typebound_user_op (declared, NULL, cmp->name,
-					 true, NULL);
-
-      /* Should be an error but we pass on it for now.  */
-      if (st == NULL || !st->n.tb->is_generic)
-	continue;
-
-      vtab = NULL;
-
-      /* Build a vtab and a special vtype, with only the procedure
-	 pointer fields, to carry the pointers to the specific
-	 procedures.  Should this name ever be changed, the same
-	 should be done in trans-expr.c(gfc_trans_assign_vtab_procs). */
-      sprintf (name, "vtab$%s$%s", vtype->name, cmp->name);
-      gfc_find_symbol (name, derived->ns, 0, &vtab);
-      if (vtab == NULL)
-	{
-	  gfc_get_symbol (name, derived->ns, &vtab);
-	  vtab->ts.type = BT_DERIVED;
-	  vtab->attr.flavor = FL_VARIABLE;
-	  vtab->attr.target = 1;
-	  vtab->attr.save = SAVE_EXPLICIT;
-	  vtab->attr.vtab = 1;
-	  vtab->refs++;
-	  gfc_set_sym_referenced (vtab);
-	  sprintf (name, "%s$%s", vtype->name, cmp->name);
-	  
-	  gfc_find_symbol (name, derived->ns, 0, &cmp->ts.u.derived);
-	  if (cmp->ts.u.derived == NULL
-		|| (strcmp (cmp->ts.u.derived->name, "$empty") == 0))
-	    {
-	      gfc_get_symbol (name, derived->ns, &cmp->ts.u.derived);
-	      if (gfc_add_flavor (&cmp->ts.u.derived->attr, FL_DERIVED,
-				  NULL, &gfc_current_locus) == FAILURE)
-		return;
-	      cmp->ts.u.derived->refs++;
-	      gfc_set_sym_referenced (cmp->ts.u.derived);
-	      cmp->ts.u.derived->attr.vtype = 1;
-	      cmp->ts.u.derived->attr.zero_comp = 1;
-	    }
-	  vtab->ts.u.derived = cmp->ts.u.derived;
-	}
-
-      /* Store this for later use in setting the pointer.  */
-      cmp->ts.interface = vtab;
-
-      if (vtab->ts.u.derived->components)
-	continue;
-
-      super_type = gfc_get_derived_super_type (declared);
+      /* Make sure that the PPCs appear in the same order as in the parent.  */
+      copy_vtab_proc_comps (super_type, vtype);
+      /* Only needed to get the PPC interfaces right.  */
+      add_procs_to_declared_vtab (super_type, vtype);
+    }
 
-      if (super_type && (super_type != declared))
-	add_generic_specifics (super_type, vtab, cmp->name);
+  if (derived->f2k_derived && derived->f2k_derived->tb_sym_root)
+    add_procs_to_declared_vtab1 (derived->f2k_derived->tb_sym_root, vtype);
 
-      add_generic_specifics (declared, vtab, cmp->name);
-    }
+  if (derived->f2k_derived && derived->f2k_derived->tb_uop_root)
+    add_procs_to_declared_vtab1 (derived->f2k_derived->tb_uop_root, vtype);
 }
 
 
-/* Find the symbol for a derived type's vtab.  A vtab has the following
-   fields:
-   $hash	a hash value used to identify the derived type
-   $size	the size in bytes of the derived type
-   $extends	a pointer to the vtable of the parent derived type
-   then:
-   procedure pointer components for the specific typebound procedures
-   structure pointers to reduced vtabs that contain procedure
-   pointers to the specific procedures.  */
+/* Find the symbol for a derived type's vtab.
+   A vtab has the following fields:
+    * $hash	a hash value used to identify the derived type
+    * $size	the size in bytes of the derived type
+    * $extends	a pointer to the vtable of the parent derived type
+   After these follow procedure pointer components for the
+   specific type-bound procedures.  */
 
 gfc_symbol *
-gfc_find_derived_vtab (gfc_symbol *derived, bool resolved)
+gfc_find_derived_vtab (gfc_symbol *derived)
 {
   gfc_namespace *ns;
   gfc_symbol *vtab = NULL, *vtype = NULL;
@@ -608,7 +390,7 @@ gfc_find_derived_vtab (gfc_symbol *derived, bool resolved)
 	      parent = gfc_get_derived_super_type (derived);
 	      if (parent)
 		{
-		  parent_vtab = gfc_find_derived_vtab (parent, resolved);
+		  parent_vtab = gfc_find_derived_vtab (parent);
 		  c->ts.type = BT_DERIVED;
 		  c->ts.u.derived = parent_vtab->ts.u.derived;
 		  c->initializer = gfc_get_expr ();
@@ -623,7 +405,7 @@ gfc_find_derived_vtab (gfc_symbol *derived, bool resolved)
 		  c->initializer = gfc_get_null_expr (NULL);
 		}
 
-	      add_procs_to_declared_vtab (derived, vtype, derived, resolved);
+	      add_procs_to_declared_vtab (derived, vtype);
 	      vtype->attr.vtype = 1;
 	    }
 
@@ -632,15 +414,6 @@ gfc_find_derived_vtab (gfc_symbol *derived, bool resolved)
 	}
     }
 
-  /* Catch the call just before the backend declarations are built, so that
-     the generic procedures have been resolved and the specific procedures
-     have formal interfaces that can be compared.  */
-  if (resolved
-	&& vtab->ts.u.derived
-	&& vtab->ts.u.derived->backend_decl == NULL)
-    add_generics_to_declared_vtab (derived, vtab->ts.u.derived,
-				   derived, resolved);
-
   return vtab;
 }
 
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 60864807db6..cf14bb46af2 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2820,7 +2820,7 @@ void gfc_add_component_ref (gfc_expr *, const char *);
 gfc_expr *gfc_class_null_initializer (gfc_typespec *);
 gfc_try gfc_build_class_symbol (gfc_typespec *, symbol_attribute *,
 				gfc_array_spec **, bool);
-gfc_symbol *gfc_find_derived_vtab (gfc_symbol *, bool);
+gfc_symbol *gfc_find_derived_vtab (gfc_symbol *);
 gfc_symtree* gfc_find_typebound_proc (gfc_symbol*, gfc_try*,
 				      const char*, bool, locus*);
 gfc_symtree* gfc_find_typebound_user_op (gfc_symbol*, gfc_try*,
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index c09ae9738fa..9bf767dbaf6 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -854,7 +854,7 @@ gfc_resolve_extends_type_of (gfc_expr *f, gfc_expr *a, gfc_expr *mo)
     gfc_add_component_ref (a, "$vptr");
   else if (a->ts.type == BT_DERIVED)
     {
-      vtab = gfc_find_derived_vtab (a->ts.u.derived, false);
+      vtab = gfc_find_derived_vtab (a->ts.u.derived);
       /* Clear the old expr.  */
       gfc_free_ref_list (a->ref);
       memset (a, '\0', sizeof (gfc_expr));
@@ -870,7 +870,7 @@ gfc_resolve_extends_type_of (gfc_expr *f, gfc_expr *a, gfc_expr *mo)
     gfc_add_component_ref (mo, "$vptr");
   else if (mo->ts.type == BT_DERIVED)
     {
-      vtab = gfc_find_derived_vtab (mo->ts.u.derived, false);
+      vtab = gfc_find_derived_vtab (mo->ts.u.derived);
       /* Clear the old expr.  */
       gfc_free_ref_list (mo->ref);
       memset (mo, '\0', sizeof (gfc_expr));
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index f3ec19ccdbc..640a4d89fe1 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5477,7 +5477,6 @@ resolve_typebound_function (gfc_expr* e)
   gfc_ref *class_ref;
   gfc_symtree *st;
   const char *name;
-  const char *genname;
   gfc_typespec ts;
 
   st = e->symtree;
@@ -5501,11 +5500,6 @@ resolve_typebound_function (gfc_expr* e)
   c = gfc_find_component (declared, "$data", true, true);
   declared = c->ts.u.derived;
 
-  /* Keep the generic name so that the vtab reference can be made.  */
-  genname = NULL; 
-  if (e->value.compcall.tbp->is_generic)
-    genname = e->value.compcall.name;
-
   /* Treat the call as if it is a typebound procedure, in order to roll
      out the correct name for the specific function.  */
   if (resolve_compcall (e, &name) == FAILURE)
@@ -5521,15 +5515,6 @@ resolve_typebound_function (gfc_expr* e)
 
   /* '$vptr' points to the vtab, which contains the procedure pointers.  */
   gfc_add_component_ref (e, "$vptr");
-  if (genname)
-    {
-      /* A generic procedure needs the subsidiary vtabs and vtypes for
-	 the specific procedures to have been build.  */
-      gfc_symbol *vtab;
-      vtab = gfc_find_derived_vtab (declared, true);
-      gcc_assert (vtab);
-      gfc_add_component_ref (e, genname);
-    }
   gfc_add_component_ref (e, name);
 
   /* Recover the typespec for the expression.  This is really only
@@ -5552,7 +5537,6 @@ resolve_typebound_subroutine (gfc_code *code)
   gfc_ref *new_ref;
   gfc_ref *class_ref;
   gfc_symtree *st;
-  const char *genname;
   const char *name;
   gfc_typespec ts;
 
@@ -5577,11 +5561,6 @@ resolve_typebound_subroutine (gfc_code *code)
   c = gfc_find_component (declared, "$data", true, true);
   declared = c->ts.u.derived;
 
-  /* Keep the generic name so that the vtab reference can be made.  */
-  genname = NULL; 
-  if (code->expr1->value.compcall.tbp->is_generic)
-    genname = code->expr1->value.compcall.name;
-
   if (resolve_typebound_call (code, &name) == FAILURE)
     return FAILURE;
   ts = code->expr1->ts;
@@ -5595,15 +5574,6 @@ resolve_typebound_subroutine (gfc_code *code)
 
   /* '$vptr' points to the vtab, which contains the procedure pointers.  */
   gfc_add_component_ref (code->expr1, "$vptr");
-  if (genname)
-    {
-      /* A generic procedure needs the subsidiary vtabs and vtypes for
-	 the specific procedures to have been build.  */
-      gfc_symbol *vtab;
-      vtab = gfc_find_derived_vtab (declared, true);
-      gcc_assert (vtab);
-      gfc_add_component_ref (code->expr1, genname);
-    }
   gfc_add_component_ref (code->expr1, name);
 
   /* Recover the typespec for the expression.  This is really only
@@ -7505,7 +7475,7 @@ resolve_select_type (gfc_code *code)
 	  new_st->expr1->value.function.actual = gfc_get_actual_arglist ();
 	  new_st->expr1->value.function.actual->expr = gfc_get_variable_expr (code->expr1->symtree);
 	  gfc_add_component_ref (new_st->expr1->value.function.actual->expr, "$vptr");
-	  vtab = gfc_find_derived_vtab (body->ext.case_list->ts.u.derived, true);
+	  vtab = gfc_find_derived_vtab (body->ext.case_list->ts.u.derived);
 	  st = gfc_find_symtree (vtab->ns->sym_root, vtab->name);
 	  new_st->expr1->value.function.actual->next = gfc_get_actual_arglist ();
 	  new_st->expr1->value.function.actual->next->expr = gfc_get_variable_expr (st);
@@ -10777,7 +10747,7 @@ resolve_fl_derived (gfc_symbol *sym)
       gfc_component *vptr = gfc_find_component (sym, "$vptr", true, true);
       if (vptr->ts.u.derived == NULL)
 	{
-	  gfc_symbol *vtab = gfc_find_derived_vtab (data->ts.u.derived, false);
+	  gfc_symbol *vtab = gfc_find_derived_vtab (data->ts.u.derived);
 	  gcc_assert (vtab);
 	  vptr->ts.u.derived = vtab->ts.u.derived;
 	}
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 1331148dddb..5fee6e23cfc 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1077,7 +1077,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
     {
       gfc_component *c = CLASS_DATA (sym);
       if (!c->ts.u.derived->backend_decl)
-	gfc_find_derived_vtab (c->ts.u.derived, true);
+	gfc_find_derived_vtab (c->ts.u.derived);
     }
 
   if ((sym->attr.dummy && ! sym->attr.function) || (sym->attr.result && byref))
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 5f2eda29693..ff250fdbfee 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2478,8 +2478,8 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
 		       var, cmp->backend_decl, NULL_TREE);
 
   /* Remember the vtab corresponds to the derived type
-    not to the class declared type.  */
-  vtab = gfc_find_derived_vtab (e->ts.u.derived, true);
+     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));
@@ -5641,7 +5641,7 @@ gfc_trans_class_assign (gfc_code *code)
 	{
 	  gfc_symbol *vtab;
 	  gfc_symtree *st;
-	  vtab = gfc_find_derived_vtab (code->expr2->ts.u.derived, true);
+	  vtab = gfc_find_derived_vtab (code->expr2->ts.u.derived);
 	  gcc_assert (vtab);
 	  gfc_trans_assign_vtab_procs (&block, code->expr2->ts.u.derived, vtab);
 	  rhs = gfc_get_expr ();
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index bdf4d1186ed..8bd0f91517f 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -4295,7 +4295,7 @@ gfc_trans_allocate (gfc_code * code)
 
 	      if (ts->type == BT_DERIVED)
 		{
-		  vtab = gfc_find_derived_vtab (ts->u.derived, true);
+		  vtab = gfc_find_derived_vtab (ts->u.derived);
 		  gcc_assert (vtab);
 		  gfc_trans_assign_vtab_procs (&block, ts->u.derived, vtab);
 		  gfc_init_se (&lse, NULL);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 6b69a63185a..9f4bd1e1477 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,17 @@
+2010-07-13  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44434
+	PR fortran/44565
+	PR fortran/43945
+	PR fortran/44869
+	* gfortran.dg/dynamic_dispatch_1.f03: Fixed invalid test case.
+	* gfortran.dg/dynamic_dispatch_2.f03: Ditto.
+	* gfortran.dg/dynamic_dispatch_3.f03: Ditto.
+	* gfortran.dh/typebound_call_16.f03: New.
+	* gfortran.dg/typebound_generic_6.f03: New.
+	* gfortran.dg/typebound_generic_7.f03: New.
+	* gfortran.dg/typebound_generic_8.f03: New.
+
 2010-07-12  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR libfortran/37077
diff --git a/gcc/testsuite/gfortran.dg/dynamic_dispatch_1.f03 b/gcc/testsuite/gfortran.dg/dynamic_dispatch_1.f03
index 4854b0ff08d..2182dce3e4f 100644
--- a/gcc/testsuite/gfortran.dg/dynamic_dispatch_1.f03
+++ b/gcc/testsuite/gfortran.dg/dynamic_dispatch_1.f03
@@ -12,16 +12,14 @@ module m
     procedure, pass :: make_integer
     procedure, pass :: prod => i_m_j
     generic, public :: extract => real, make_integer
-    generic, public :: base_extract => real, make_integer
   end type t1
 
   type, extends(t1) :: t2
     integer :: j = 99
   contains
     procedure, pass :: real => make_real2
-    procedure, pass :: make_integer_2
+    procedure, pass :: make_integer => make_integer_2
     procedure, pass :: prod => i_m_j_2
-    generic, public :: extract => real, make_integer_2
   end type t2
 contains
   real function make_real (arg)
@@ -69,16 +67,13 @@ end module m
   if (a%real() .ne. real (42)) call abort
   if (a%prod() .ne. 42) call abort
   if (a%extract (2) .ne. 84) call abort
-  if (a%base_extract (2) .ne. 84) call abort
   a => c                                   ! extension in module
   if (a%real() .ne. real (99)) call abort
   if (a%prod() .ne. 99) call abort
   if (a%extract (3) .ne. 297) call abort
-  if (a%base_extract (3) .ne. 126) call abort
   a => d                                   ! extension in main
   if (a%real() .ne. real (42)) call abort
   if (a%prod() .ne. 42) call abort
   if (a%extract (4) .ne. 168) call abort
-  if (a%base_extract (4) .ne. 168) call abort
 end
 ! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/dynamic_dispatch_2.f03 b/gcc/testsuite/gfortran.dg/dynamic_dispatch_2.f03
index 989a2e0d3f0..95ce8372325 100644
--- a/gcc/testsuite/gfortran.dg/dynamic_dispatch_2.f03
+++ b/gcc/testsuite/gfortran.dg/dynamic_dispatch_2.f03
@@ -12,16 +12,14 @@ module m
     procedure, pass :: make_integer
     procedure, pass :: prod => i_m_j
     generic, public :: extract => real, make_integer
-    generic, public :: base_extract => real, make_integer
   end type t1
 
   type, extends(t1) :: t2
     integer :: j = 99
   contains
     procedure, pass :: real => make_real2
-    procedure, pass :: make_integer_2
+    procedure, pass :: make_integer => make_integer_2
     procedure, pass :: prod => i_m_j_2
-    generic, public :: extract => real, make_integer_2
   end type t2
 contains
   subroutine make_real (arg, arg2)
@@ -79,8 +77,6 @@ end module m
   if (i .ne. 42) call abort
   call a%extract (2, i)
   if (i .ne. 84) call abort
-  call a%base_extract (2, i)
-  if (i .ne. 84) call abort
 
   a => c                                   ! extension in module
   call a%real(r)
@@ -89,8 +85,6 @@ end module m
   if (i .ne. 99) call abort
   call a%extract (3, i)
   if (i .ne. 297) call abort
-  call a%base_extract (3, i)
-  if (i .ne. 126) call abort
 
   a => d                                   ! extension in main
   call a%real(r)
@@ -99,7 +93,5 @@ end module m
   if (i .ne. 42) call abort
   call a%extract (4, i)
   if (i .ne. 168) call abort
-  call a%extract (4, i)
-  if (i .ne. 168) call abort
 end
 ! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/dynamic_dispatch_3.f03 b/gcc/testsuite/gfortran.dg/dynamic_dispatch_3.f03
index aa8713ef4d4..884d3426039 100644
--- a/gcc/testsuite/gfortran.dg/dynamic_dispatch_3.f03
+++ b/gcc/testsuite/gfortran.dg/dynamic_dispatch_3.f03
@@ -15,7 +15,6 @@ module m1
     procedure, pass :: make_integer
     procedure, pass :: prod => i_m_j
     generic, public :: extract => real, make_integer
-    generic, public :: base_extract => real, make_integer
   end type t1
 contains
   real function make_real (arg)
@@ -41,9 +40,8 @@ module m2
     integer :: j = 99
   contains
     procedure, pass :: real => make_real2
-    procedure, pass :: make_integer_2
+    procedure, pass :: make_integer => make_integer_2
     procedure, pass :: prod => i_m_j_2
-    generic, public :: extract => real, make_integer_2
   end type t2
 contains
   real function make_real2 (arg)
@@ -76,16 +74,13 @@ end module m2
   if (a%real() .ne. real (42)) call abort
   if (a%prod() .ne. 42) call abort
   if (a%extract (2) .ne. 84) call abort
-  if (a%base_extract (2) .ne. 84) call abort
   a => c                                   ! extension in module m2
   if (a%real() .ne. real (99)) call abort
   if (a%prod() .ne. 99) call abort
   if (a%extract (3) .ne. 297) call abort
-  if (a%base_extract (3) .ne. 126) call abort
   a => d                                   ! extension in main
   if (a%real() .ne. real (42)) call abort
   if (a%prod() .ne. 42) call abort
   if (a%extract (4) .ne. 168) call abort
-  if (a%base_extract (4) .ne. 168) call abort
 end
 ! { dg-final { cleanup-modules "m1, m2" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_call_16.f03 b/gcc/testsuite/gfortran.dg/typebound_call_16.f03
new file mode 100644
index 00000000000..fdd60c603cc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_call_16.f03
@@ -0,0 +1,35 @@
+! { dg-do compile }
+!
+! PR 41685: [OOP] internal compiler error: verify_flow_info failed
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+
+module base_mat_mod
+
+  type  :: base_sparse_mat
+  contains 
+    procedure, pass(a) :: get_nrows
+  end type base_sparse_mat
+  
+contains
+
+  integer function get_nrows(a)
+    implicit none 
+    class(base_sparse_mat), intent(in) :: a
+  end function get_nrows
+
+end module  base_mat_mod
+
+
+  use base_mat_mod
+
+  type, extends(base_sparse_mat) :: s_coo_sparse_mat
+  end type s_coo_sparse_mat
+
+  class(s_coo_sparse_mat), pointer :: a
+  Integer :: m
+  m = a%get_nrows()
+
+end
+
+! { dg-final { cleanup-modules "base_mat_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_generic_6.f03 b/gcc/testsuite/gfortran.dg/typebound_generic_6.f03
new file mode 100644
index 00000000000..973e10a35e3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_generic_6.f03
@@ -0,0 +1,69 @@
+! { dg-do run }
+!
+! PR 43945: [OOP] Derived type with GENERIC: resolved to the wrong specific TBP
+!
+! Contributed by by Salvatore Filippone <sfilippone@uniroma2.it>
+
+module foo_mod
+  type foo
+    integer :: i
+  contains
+    procedure, pass(a) :: doit
+    procedure, pass(a) :: getit
+    generic, public :: do  => doit
+    generic, public :: get => getit
+  end type foo
+  private doit,getit
+contains
+  subroutine  doit(a)
+    class(foo) :: a
+    a%i = 1
+    write(*,*) 'FOO%DOIT base version'
+  end subroutine doit
+  function getit(a) result(res)
+    class(foo) :: a
+    integer :: res
+    res = a%i
+  end function getit
+end module foo_mod
+
+module foo2_mod
+  use foo_mod
+  type, extends(foo) :: foo2
+    integer :: j
+  contains
+    procedure, pass(a) :: doit  => doit2
+    procedure, pass(a) :: getit => getit2
+  end type foo2
+  private doit2, getit2
+
+contains
+
+  subroutine  doit2(a)
+    class(foo2) :: a
+    a%i = 2
+    a%j = 3
+  end subroutine doit2
+  function getit2(a) result(res)
+    class(foo2) :: a
+    integer :: res
+    res = a%j
+  end function getit2
+end module foo2_mod
+
+program testd15
+  use foo2_mod
+  type(foo2) :: af2
+  class(foo), allocatable :: afab 
+
+  allocate(foo2 :: afab)
+  call af2%do()
+  if (af2%i .ne. 2) call abort
+  if (af2%get() .ne. 3) call abort
+  call afab%do()
+  if (afab%i .ne. 2) call abort
+  if (afab%get() .ne. 3) call abort
+
+end program testd15
+
+! { dg-final { cleanup-modules "foo_mod foo2_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_generic_7.f03 b/gcc/testsuite/gfortran.dg/typebound_generic_7.f03
new file mode 100644
index 00000000000..2519ab09416
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_generic_7.f03
@@ -0,0 +1,28 @@
+! { dg-do compile }
+!
+! PR 44434: [OOP] ICE in in gfc_add_component_ref
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+
+module foo_mod
+  type foo
+  contains
+    procedure :: doit
+    generic :: do => doit
+  end type
+contains
+  subroutine  doit(a) 
+    class(foo) :: a
+  end subroutine
+end module
+
+program testd15
+contains
+  subroutine dodo(x)
+    use foo_mod
+    class(foo) :: x
+    call x%do()
+  end subroutine
+end 
+
+! { dg-final { cleanup-modules "foo_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_generic_8.f03 b/gcc/testsuite/gfortran.dg/typebound_generic_8.f03
new file mode 100644
index 00000000000..0ee6610e173
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_generic_8.f03
@@ -0,0 +1,29 @@
+! { dg-do compile }
+!
+! PR 44565: [4.6 Regression] [OOP] ICE in gimplify_expr with array-valued generic TBP
+!
+! Contributed by Hans-Werner Boschmann <boschmann@tp1.physik.uni-siegen.de>
+
+module ice6
+
+  type :: t
+   contains
+     procedure :: get_array
+     generic :: get_something => get_array
+  end type
+
+contains
+
+  function get_array(this)
+    class(t) :: this
+    real,dimension(2) :: get_array
+  end function get_array
+
+  subroutine do_something(this)
+    class(t) :: this
+    print *,this%get_something()
+  end subroutine do_something
+
+end module ice6 
+
+! { dg-final { cleanup-modules "ice6" } }
-- 
2.30.2