blob: ce821dfb13eda216292e29cb90c405e7d1de7c1f (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
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) STOP 1
end subroutine
end
|
