Mercurial > hg > CbC > CbC_gcc

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children 84e7813d76e9
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
1 ! { dg-do run }
2 !
3 ! PR 59654: [4.8/4.9 Regression] [OOP] Broken function table with complex OO use case
4 !
5 ! Contributed by Thomas Clune <Thomas.L.Clune@nasa.gov>
6
7 module TestResult_mod
8 implicit none
9
10 type TestResult
11 integer :: numRun = 0
12 contains
13 procedure :: run
14 procedure, nopass :: getNumRun
15 end type
16
17 contains
18
19 subroutine run (this)
20 class (TestResult) :: this
21 this%numRun = this%numRun + 1
22 end subroutine
23
24 subroutine getNumRun()
25 end subroutine
26
27 end module
28
29
30 module BaseTestRunner_mod
31 implicit none
32
33 type :: BaseTestRunner
34 contains
35 procedure, nopass :: norun
36 end type
37
38 contains
39
40 function norun () result(result)
41 use TestResult_mod, only: TestResult
42 type (TestResult) :: result
43 end function
44
45 end module
46
47
48 module TestRunner_mod
49 use BaseTestRunner_mod, only: BaseTestRunner
50 implicit none
51 end module
52
53
54 program main
55 use TestRunner_mod, only: BaseTestRunner
56 use TestResult_mod, only: TestResult
57 implicit none
58
59 type (TestResult) :: result
60
61 call runtest (result)
62
63 contains
64
65 subroutine runtest (result)
66 use TestResult_mod, only: TestResult
67 class (TestResult) :: result
68 call result%run()
69 if (result%numRun /= 1) call abort()
70 end subroutine
71
72 end