gcc/testsuite/gfortran.dg/typebound_override_4.f90

   1 ! { dg-do compile }
   2 !
   3 ! PR 57217: [4.7/4.8/4.9 Regression][OOP] Accepts invalid TBP overriding - lacking arguments check
   4 !
   5 ! Contributed by Salvatore Filippone <filippone.salvatore@gmail.com>
   6
   7 module base_mod
   8   implicit none
   9   type base_type
  10   contains
  11     procedure, pass(map)  :: clone    => base_clone
  12   end type
  13 contains
  14   subroutine  base_clone(map,mapout)
  15     class(base_type) :: map
  16     class(base_type) :: mapout
  17   end subroutine
  18 end module
  19
  20 module r_mod
  21   use base_mod
  22   implicit none
  23   type, extends(base_type) :: r_type
  24   contains
  25     procedure, pass(map)  :: clone    => r_clone   ! { dg-error "Type mismatch in argument" }
  26   end type
  27 contains
  28   subroutine  r_clone(map,mapout)
  29     class(r_type) :: map
  30     class(r_type) :: mapout
  31   end subroutine
  32 end module