gcc/testsuite/gfortran.dg/dynamic_dispatch_12.f90

   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
  73
  74 ! { dg-final { cleanup-modules "TestResult_mod BaseTestRunner_mod TestRunner_mod" } }