gcc/testsuite/gfortran.dg/typebound_override_7.f90

   1 ! { dg-do compile }
   2 !
   3 ! PR 54190: TYPE(*)/assumed-rank: Type/rank check too relaxed for dummy procedure
   4 ! PR 57217: [4.7/4.8/4.9 Regression][OOP] Accepts invalid TBP overriding - lacking arguments check
   5 !
   6 ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
   7
   8 module base_mod
   9   implicit none
  10   type base_type
  11     integer :: kind
  12   contains
  13     procedure, pass(map)  :: clone    => base_clone
  14   end type
  15 contains
  16   subroutine  base_clone(map,mapout,info)
  17     class(base_type), intent(inout) :: map
  18     class(base_type), intent(inout) :: mapout
  19     integer     :: info
  20   end subroutine
  21 end module
  22
  23 module r_mod
  24   use base_mod
  25   implicit none
  26   type, extends(base_type) :: r_type
  27     real  :: dat
  28   contains
  29     procedure, pass(map)  :: clone    => r_clone   ! { dg-error "Type mismatch in argument" }
  30   end type
  31 contains
  32   subroutine  r_clone(map,mapout,info)
  33     class(r_type), intent(inout) :: map
  34     type(*), intent(inout) :: mapout
  35     integer     :: info
  36   end subroutine
  37 end module
  38
  39 ! { dg-final { cleanup-modules "base_mod r_mod" } }