1! { dg-do run }
2! Tests dynamic dispatch of class functions, spread over
3! different modules. Apart from the location of the derived
4! type declarations, this test is the same as
5! dynamic_dispatch_1.f03
6!
7! Contributed by Paul Thomas <pault@gcc.gnu.org>
8!
9module m1
10  type :: t1
11    integer :: i = 42
12    procedure(make_real), pointer :: ptr
13  contains
14    procedure, pass :: real => make_real
15    procedure, pass :: make_integer
16    procedure, pass :: prod => i_m_j
17    generic, public :: extract => real, make_integer
18  end type t1
19contains
20  real function make_real (arg)
21    class(t1), intent(in) :: arg
22    make_real = real (arg%i)
23  end function make_real
24
25  integer function make_integer (arg, arg2)
26    class(t1), intent(in) :: arg
27    integer :: arg2
28    make_integer = arg%i * arg2
29  end function make_integer
30
31  integer function i_m_j (arg)
32    class(t1), intent(in) :: arg
33        i_m_j = arg%i
34  end function i_m_j
35end module m1
36
37module m2
38  use m1
39  type, extends(t1) :: t2
40    integer :: j = 99
41  contains
42    procedure, pass :: real => make_real2
43    procedure, pass :: make_integer => make_integer_2
44    procedure, pass :: prod => i_m_j_2
45  end type t2
46contains
47  real function make_real2 (arg)
48    class(t2), intent(in) :: arg
49    make_real2 = real (arg%j)
50  end function make_real2
51
52  integer function make_integer_2 (arg, arg2)
53    class(t2), intent(in) :: arg
54    integer :: arg2
55    make_integer_2 = arg%j * arg2
56  end function make_integer_2
57
58  integer function i_m_j_2 (arg)
59    class(t2), intent(in) :: arg
60        i_m_j_2 = arg%j
61  end function i_m_j_2
62end module m2
63
64  use m1
65  use m2
66  type, extends(t1) :: l1
67    character(16) :: chr
68  end type l1
69  class(t1), pointer :: a !=> NULL()
70  type(t1), target :: b
71  type(t2), target :: c
72  type(l1), target :: d
73  a => b                                   ! declared type in module m1
74  if (a%real() .ne. real (42)) call abort
75  if (a%prod() .ne. 42) call abort
76  if (a%extract (2) .ne. 84) call abort
77  a => c                                   ! extension in module m2
78  if (a%real() .ne. real (99)) call abort
79  if (a%prod() .ne. 99) call abort
80  if (a%extract (3) .ne. 297) call abort
81  a => d                                   ! extension in main
82  if (a%real() .ne. real (42)) call abort
83  if (a%prod() .ne. 42) call abort
84  if (a%extract (4) .ne. 168) call abort
85end
86