re PR fortran/42144 ([OOP] deferred TBPs do not work)

gcc/fortran/
2009-12-17 Janus Weil  <janus@gcc.gnu.org>

	PR fortran/42144
	* trans-expr.c (select_class_proc): Skip abstract base types.

gcc/testsuite/
2009-12-17  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/42144
	* gfortran.dg/dynamic_dispatch_6.f03: New test.

From-SVN: r155305

4 files changed, 83 insertions, 0 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 1d34ae8..f65bcd0 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2009-12-17 Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42144
+	* trans-expr.c (select_class_proc): Skip abstract base types.
+
 2009-12-16  Kazu Hirata  <kazu@codesourcery.com>
 
 	* gfc-internals.texi, gfortran.texi, invoke.texi: Fix typos.
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index acca306..b0c19c9 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1556,6 +1556,10 @@ select_class_proc (gfc_se *se, gfc_class_esym_list *elist,
       if (elist->derived == NULL)
 	goto free_elist;
 
+      /* Skip abstract base types.  */
+      if (elist->derived->attr.abstract)
+       goto free_elist;
+
       /* Run through the chain picking up all the cases that call the
 	 same procedure.  */
       tmp_elist = elist;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f162037..77bd4ee 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2009-12-17  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42144
+	* gfortran.dg/dynamic_dispatch_6.f03: New test.
+
 2009-12-17  Shujing Zhao  <pearly.zhao@oracle.com>
 
 	* g++.old-deja/g++.mike/net31.C: Make expected dg-error strings
diff --git a/gcc/testsuite/gfortran.dg/dynamic_dispatch_6.f03 b/gcc/testsuite/gfortran.dg/dynamic_dispatch_6.f03
new file mode 100644
index 0000000..e2d880e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dynamic_dispatch_6.f03
@@ -0,0 +1,69 @@
+! { dg-do run }
+!
+! PR 42144: [OOP] deferred TBPs do not work
+!
+! Contributed by Damian Rouson <damian@rouson.net>
+
+module field_module
+  implicit none
+  private
+  public :: field
+  type ,abstract :: field 
+  end type
+end module
+
+module periodic_5th_order_module
+  use field_module ,only : field
+  implicit none
+  type ,extends(field) :: periodic_5th_order
+  end type
+end module
+
+module field_factory_module
+  implicit none
+  private
+  public :: field_factory
+  type, abstract :: field_factory 
+  contains 
+    procedure(create_interface), deferred :: create 
+  end type 
+  abstract interface 
+    function create_interface(this) 
+      use field_module ,only : field
+      import :: field_factory
+      class(field_factory), intent(in) :: this 
+      class(field) ,pointer :: create_interface
+    end function
+  end interface 
+end module
+
+module periodic_5th_factory_module
+  use field_factory_module , only : field_factory
+  implicit none
+  private
+  public :: periodic_5th_factory
+  type, extends(field_factory) :: periodic_5th_factory 
+  contains 
+    procedure :: create=>new_periodic_5th_order
+  end type 
+contains
+  function new_periodic_5th_order(this) 
+    use field_module ,only : field
+    use periodic_5th_order_module ,only : periodic_5th_order
+    class(periodic_5th_factory), intent(in) :: this
+    class(field) ,pointer :: new_periodic_5th_order
+  end function
+end module
+
+program main 
+  use field_module ,only : field 
+  use field_factory_module ,only : field_factory
+  use periodic_5th_factory_module ,only : periodic_5th_factory
+  implicit none 
+  class(field) ,pointer :: u
+  class(field_factory), allocatable :: field_creator 
+  allocate (periodic_5th_factory ::  field_creator) 
+  u => field_creator%create() 
+end program
+
+! { dg-final { cleanup-modules "field_module periodic_5th_order_module field_factory_module periodic_5th_factory_module" } }