Mercurial > hg > CbC > CbC_gcc
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