gcc/testsuite/gfortran.dg/dynamic_dispatch_9.f03

   1 ! { dg-do run }
   2 !
   3 ! [OOP] Ensure that different specifc interfaces are
   4 ! handled properly by dynamic dispatch.
   5 !
   6 ! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
   7 !
   8 module m
   9
  10  type :: t
  11  contains
  12   procedure :: a
  13   generic :: gen => a
  14  end type
  15
  16  type,extends(t) :: t2
  17  contains
  18   procedure :: b
  19   generic :: gen => b
  20  end type
  21
  22 contains
  23
  24   real function a(ct,x)
  25     class(t) :: ct
  26     real :: x
  27     a=2*x
  28   end function
  29
  30   integer function b(ct,x)
  31     class(t2) :: ct
  32     integer :: x
  33     b=3*x
  34   end function
  35
  36 end
  37
  38
  39  use m
  40  class(t), allocatable :: o1
  41  type (t) :: t1
  42  class(t2), allocatable :: o2
  43
  44  allocate(o1)
  45  allocate(o2)
  46
  47  if (t1%gen(2.0) .ne. o1%gen(2.0)) STOP 1
  48  if (t1%gen(2.0) .ne. o2%gen(2.0)) STOP 2
  49  if (o2%gen(3) .ne. 9) STOP 3
  50
  51 end