aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/gcc/testsuite/gfortran.dg/dynamic_dispatch_6.f03
blob: e54966bf1e176624ed207cebd529ee4d5ecc4fc6 (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
! { dg-do run }
!
! PR 42144: [OOP] deferred TBPs do not work
!
! Contributed by Damian Rouson <damian@rouson.net>

module field_module
  implicit none
  private
  public :: field
  type ,abstract :: field 
  end type
end module

module periodic_5th_order_module
  use field_module ,only : field
  implicit none
  type ,extends(field) :: periodic_5th_order
  end type
end module

module field_factory_module
  implicit none
  private
  public :: field_factory
  type, abstract :: field_factory 
  contains 
    procedure(create_interface), deferred :: create 
  end type 
  abstract interface 
    function create_interface(this) 
      use field_module ,only : field
      import :: field_factory
      class(field_factory), intent(in) :: this 
      class(field) ,pointer :: create_interface
    end function
  end interface 
end module

module periodic_5th_factory_module
  use field_factory_module , only : field_factory
  implicit none
  private
  public :: periodic_5th_factory
  type, extends(field_factory) :: periodic_5th_factory 
  contains 
    procedure :: create=>new_periodic_5th_order
  end type 
contains
  function new_periodic_5th_order(this) 
    use field_module ,only : field
    use periodic_5th_order_module ,only : periodic_5th_order
    class(periodic_5th_factory), intent(in) :: this
    class(field) ,pointer :: new_periodic_5th_order
  end function
end module

program main 
  use field_module ,only : field 
  use field_factory_module ,only : field_factory
  use periodic_5th_factory_module ,only : periodic_5th_factory
  implicit none 
  class(field) ,pointer :: u
  class(field_factory), allocatable :: field_creator 
  allocate (periodic_5th_factory ::  field_creator) 
  u => field_creator%create() 
end program