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