diff gcc/testsuite/gfortran.dg/dynamic_dispatch_12.f90 @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children 84e7813d76e9
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/gfortran.dg/dynamic_dispatch_12.f90	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,72 @@
+! { 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