re PR fortran/59654 ([OOP] Broken function table with complex OO use case)

2014-01-02  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/59654
	* resolve.c (resolve_typebound_procedures): No need to create the vtab
	here.

2014-01-02  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/59654
	* gfortran.dg/dynamic_dispatch_12.f90: New.

From-SVN: r206281

gcc/fortran/resolve.c

@@ -11903,9 +11903,6 @@ resolve_typebound_procedures (gfc_symbol* derived)
   resolve_bindings_derived = derived;
   resolve_bindings_result = true;
 
-  /* Make sure the vtab has been generated.  */
-  gfc_find_derived_vtab (derived);
-
   if (derived->f2k_derived->tb_sym_root)
     gfc_traverse_symtree (derived->f2k_derived->tb_sym_root,
 			  &resolve_typebound_procedure);

gcc/testsuite/ChangeLog

+2014-01-02  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/59654
+	* gfortran.dg/dynamic_dispatch_12.f90: New.
+
 2014-01-01  Jakub Jelinek  <jakub@redhat.com>
 
 	* lib/target-supports.exp (check_effective_target_avx512f): Make sure

gcc/testsuite/gfortran.dg/dynamic_dispatch_12.f90

+! { dg-do run }
+!
+! PR 59654: [4.8/4.9 Regression] [OOP] Broken function table with complex OO use case
+!
+! Contributed by Thomas Clune <Thomas.L.Clune@nasa.gov>
+
+module TestResult_mod
+  implicit none
+
+  type TestResult
+    integer :: numRun = 0
+  contains
+    procedure :: run
+    procedure, nopass :: getNumRun
+  end type
+
+contains
+
+  subroutine run (this)
+    class (TestResult) :: this
+    this%numRun = this%numRun + 1
+  end subroutine
+
+  subroutine getNumRun()
+   end subroutine
+
+end module
+
+
+module BaseTestRunner_mod
+  implicit none
+
+  type :: BaseTestRunner
+  contains
+    procedure, nopass :: norun
+  end type
+
+contains
+
+  function norun () result(result)
+    use TestResult_mod, only: TestResult
+    type (TestResult) :: result
+  end function
+
+end module
+
+
+module TestRunner_mod
+  use BaseTestRunner_mod, only: BaseTestRunner
+  implicit none
+end module
+
+
+program main
+  use TestRunner_mod, only: BaseTestRunner
+  use TestResult_mod, only: TestResult
+  implicit none
+
+  type (TestResult) :: result
+
+  call runtest (result)
+  
+contains
+
+  subroutine runtest (result)
+    use TestResult_mod, only: TestResult
+    class (TestResult) :: result
+    call result%run()
+    if (result%numRun /= 1) call abort()
+  end subroutine
+
+end
+
+! { dg-final { cleanup-modules "TestResult_mod BaseTestRunner_mod TestRunner_mod" } }