gcc/testsuite/gfortran.dg/dynamic_dispatch_6.f03

   1 ! { dg-do run }
   2 !
   3 ! PR 42144: [OOP] deferred TBPs do not work
   4 !
   5 ! Contributed by Damian Rouson <damian@rouson.net>
   6
   7 module field_module
   8   implicit none
   9   private
  10   public :: field
  11   type ,abstract :: field
  12   end type
  13 end module
  14
  15 module periodic_5th_order_module
  16   use field_module ,only : field
  17   implicit none
  18   type ,extends(field) :: periodic_5th_order
  19   end type
  20 end module
  21
  22 module field_factory_module
  23   implicit none
  24   private
  25   public :: field_factory
  26   type, abstract :: field_factory
  27   contains
  28     procedure(create_interface), deferred :: create
  29   end type
  30   abstract interface
  31     function create_interface(this)
  32       use field_module ,only : field
  33       import :: field_factory
  34       class(field_factory), intent(in) :: this
  35       class(field) ,pointer :: create_interface
  36     end function
  37   end interface
  38 end module
  39
  40 module periodic_5th_factory_module
  41   use field_factory_module , only : field_factory
  42   implicit none
  43   private
  44   public :: periodic_5th_factory
  45   type, extends(field_factory) :: periodic_5th_factory
  46   contains
  47     procedure :: create=>new_periodic_5th_order
  48   end type
  49 contains
  50   function new_periodic_5th_order(this)
  51     use field_module ,only : field
  52     use periodic_5th_order_module ,only : periodic_5th_order
  53     class(periodic_5th_factory), intent(in) :: this
  54     class(field) ,pointer :: new_periodic_5th_order
  55   end function
  56 end module
  57
  58 program main
  59   use field_module ,only : field
  60   use field_factory_module ,only : field_factory
  61   use periodic_5th_factory_module ,only : periodic_5th_factory
  62   implicit none
  63   class(field) ,pointer :: u
  64   class(field_factory), allocatable :: field_creator
  65   allocate (periodic_5th_factory ::  field_creator)
  66   u => field_creator%create()
  67 end program
  68
  69 ! { dg-final { cleanup-modules "field_module periodic_5th_order_module field_factory_module periodic_5th_factory_module" } }