! { dg-do run } ! { dg-require-effective-target lto } ! { dg-options "-flto" } ! ! Checks that the results of module procedures have the correct characteristics ! and that submodules use the module version of vtables (PR66762). This latter ! requires the -flto compile option. ! ! Contributed by Reinhold Bader ! module mod_a implicit none type, abstract :: t_a end type t_a interface module subroutine p_a(this, q) class(t_a), intent(inout) :: this class(*), intent(in) :: q end subroutine module function create_a() result(r) class(t_a), allocatable :: r end function module subroutine print(this) class(t_a), intent(in) :: this end subroutine end interface end module mod_a module mod_b implicit none type t_b integer, allocatable :: I(:) end type t_b interface module function create_b(i) result(r) type(t_b) :: r integer :: i(:) end function end interface end module mod_b submodule(mod_b) imp_create contains module procedure create_b if (allocated(r%i)) deallocate(r%i) allocate(r%i, source=i) end procedure end submodule imp_create submodule(mod_a) imp_p_a use mod_b type, extends(t_a) :: t_imp type(t_b) :: b end type t_imp integer, parameter :: ii(2) = [1,2] contains module procedure create_a type(t_b) :: b b = create_b(ii) allocate(r, source=t_imp(b)) end procedure module procedure p_a select type (this) type is (t_imp) select type (q) type is (t_b) this%b = q class default STOP 1 end select class default STOP 2 end select end procedure p_a module procedure print select type (this) type is (t_imp) if (any (this%b%i .ne. [3,4,5])) STOP 3 class default STOP 4 end select end procedure end submodule imp_p_a program p use mod_a use mod_b implicit none class(t_a), allocatable :: a allocate(a, source=create_a()) call p_a(a, create_b([3,4,5])) call print(a) end program p