aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/gcc/testsuite/gfortran.dg/dynamic_dispatch_12.f90
blob: d37e1f6a9b5aa2a71bcffeb1d689f917d4f7cd4b (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
73
74
! { 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

! { dg-final { cleanup-modules "TestResult_mod BaseTestRunner_mod TestRunner_mod" } }