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 8module base_mod 9 implicit none 10 type base_type 11 integer :: kind 12 contains 13 procedure, pass(map) :: clone => base_clone 14 end type 15contains 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 21end module 22 23module 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 "Rank mismatch in argument" } 30 end type 31contains 32 subroutine r_clone(map,mapout,info) 33 class(r_type), intent(inout) :: map 34 class(base_type), intent(inout) :: mapout(..) 35 integer :: info 36 end subroutine 37end module 38 39! { dg-final { cleanup-modules "base_mod r_mod" } } 40