gcc/testsuite/gfortran.dg/generic_23.f03

   1 ! { dg-do run }
   2 ! Test the fix for PR43945 in which the over-ridding of 'doit' and
   3 ! 'getit' in type 'foo2' was missed in the specific binding to 'do' and 'get'.
   4 !
   5 ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
   6 ! and reported to clf by Salvatore Filippone <sfilippone@uniroma2.it>
   7 !
   8 module foo_mod
   9   type foo
  10     integer :: i
  11   contains
  12     procedure, pass(a) :: doit
  13     procedure, pass(a) :: getit
  14     generic, public :: do  => doit
  15     generic, public :: get => getit
  16   end type foo
  17   private doit,getit
  18 contains
  19   subroutine  doit(a)
  20     class(foo) :: a
  21     a%i = 1
  22     write(*,*) 'FOO%DOIT base version'
  23   end subroutine doit
  24   function getit(a) result(res)
  25     class(foo) :: a
  26     integer :: res
  27     res = a%i
  28   end function getit
  29 end module foo_mod
  30
  31 module foo2_mod
  32   use foo_mod
  33   type, extends(foo) :: foo2
  34     integer :: j
  35   contains
  36     procedure, pass(a) :: doit  => doit2
  37     procedure, pass(a) :: getit => getit2
  38 !!$    generic, public :: do  => doit
  39 !!$    generic, public :: get => getit
  40   end type foo2
  41   private doit2, getit2
  42
  43 contains
  44
  45   subroutine  doit2(a)
  46     class(foo2) :: a
  47     a%i = 2
  48     a%j = 3
  49   end subroutine doit2
  50   function getit2(a) result(res)
  51     class(foo2) :: a
  52     integer :: res
  53     res = a%j
  54   end function getit2
  55 end module foo2_mod
  56
  57 program testd15
  58   use foo2_mod
  59   type(foo2) :: af2
  60
  61   call af2%do()
  62   if (af2%i .ne. 2) STOP 1
  63   if (af2%get() .ne. 3) STOP 2
  64
  65 end program testd15