|
111
|
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 !
|
|
|
11 module 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
|
|
|
27 end module mod_a
|
|
|
28
|
|
|
29 module 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
|
|
|
40 end module mod_b
|
|
|
41
|
|
|
42 submodule(mod_b) imp_create
|
|
|
43 contains
|
|
|
44 module procedure create_b
|
|
|
45 if (allocated(r%i)) deallocate(r%i)
|
|
|
46 allocate(r%i, source=i)
|
|
|
47 end procedure
|
|
|
48 end submodule imp_create
|
|
|
49
|
|
|
50 submodule(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]
|
|
|
56 contains
|
|
|
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
|
|
131
|
70 STOP 1
|
|
111
|
71 end select
|
|
|
72 class default
|
|
131
|
73 STOP 2
|
|
111
|
74 end select
|
|
|
75 end procedure p_a
|
|
|
76 module procedure print
|
|
|
77 select type (this)
|
|
|
78 type is (t_imp)
|
|
131
|
79 if (any (this%b%i .ne. [3,4,5])) STOP 3
|
|
111
|
80 class default
|
|
131
|
81 STOP 4
|
|
111
|
82 end select
|
|
|
83 end procedure
|
|
|
84 end submodule imp_p_a
|
|
|
85
|
|
|
86 program 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)
|
|
|
94 end program p
|
