1! { dg-do run } 2! { dg-require-effective-target lto } 3! { dg-options "-flto" } 4! 5! Checks that the results of module procedures have the correct characteristics 6! and that submodules use the module version of vtables (PR66762). This latter 7! requires the -flto compile option. 8! 9! Contributed by Reinhold Bader <reinhold.bader@lrz.de> 10! 11module mod_a 12 implicit none 13 type, abstract :: t_a 14 end type t_a 15 interface 16 module subroutine p_a(this, q) 17 class(t_a), intent(inout) :: this 18 class(*), intent(in) :: q 19 end subroutine 20 module function create_a() result(r) 21 class(t_a), allocatable :: r 22 end function 23 module subroutine print(this) 24 class(t_a), intent(in) :: this 25 end subroutine 26 end interface 27end module mod_a 28 29module mod_b 30 implicit none 31 type t_b 32 integer, allocatable :: I(:) 33 end type t_b 34 interface 35 module function create_b(i) result(r) 36 type(t_b) :: r 37 integer :: i(:) 38 end function 39 end interface 40end module mod_b 41 42submodule(mod_b) imp_create 43contains 44 module procedure create_b 45 if (allocated(r%i)) deallocate(r%i) 46 allocate(r%i, source=i) 47 end procedure 48end submodule imp_create 49 50submodule(mod_a) imp_p_a 51 use mod_b 52 type, extends(t_a) :: t_imp 53 type(t_b) :: b 54 end type t_imp 55 integer, parameter :: ii(2) = [1,2] 56contains 57 module procedure create_a 58 type(t_b) :: b 59 b = create_b(ii) 60 allocate(r, source=t_imp(b)) 61 end procedure 62 63 module procedure p_a 64 select type (this) 65 type is (t_imp) 66 select type (q) 67 type is (t_b) 68 this%b = q 69 class default 70 call abort 71 end select 72 class default 73 call abort 74 end select 75 end procedure p_a 76 module procedure print 77 select type (this) 78 type is (t_imp) 79 if (any (this%b%i .ne. [3,4,5])) call abort 80 class default 81 call abort 82 end select 83 end procedure 84end submodule imp_p_a 85 86program p 87 use mod_a 88 use mod_b 89 implicit none 90 class(t_a), allocatable :: a 91 allocate(a, source=create_a()) 92 call p_a(a, create_b([3,4,5])) 93 call print(a) 94end program p 95! { dg-final { cleanup-submodules "mod_a@imp_p_a" } } 96! { dg-final { cleanup-submodules "mod_b@imp_create" } } 97 98