Mercurial > hg > CbC > CbC_gcc
view gcc/testsuite/gfortran.dg/dynamic_dispatch_12.f90 @ 158:494b0b89df80 default tip
...
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Mon, 25 May 2020 18:13:55 +0900 |
parents | 84e7813d76e9 |
children |
line wrap: on
line source
! { 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) STOP 1 end subroutine end