1! { dg-do compile }
2module m1
3  implicit none
4
5  type, abstract :: vector_class
6  end type vector_class
7end module m1
8!---------------------------------------------------------------
9module m2
10  use m1
11  implicit none
12
13  type, abstract :: inner_product_class
14  contains
15    procedure(dot), deferred :: dot_v_v
16    procedure(dot), deferred :: dot_g_g
17    procedure(sub), deferred :: D_times_v
18    procedure(sub), deferred :: D_times_g
19  end type inner_product_class
20
21  abstract interface
22    function dot (this,a,b)
23      import :: inner_product_class
24      import :: vector_class
25      class(inner_product_class), intent(in) :: this
26      class(vector_class),        intent(in) :: a,b
27      real                                   :: dot
28    end function
29    subroutine sub (this,a)
30      import :: inner_product_class
31      import :: vector_class
32      class(inner_product_class), intent(in)    :: this
33      class(vector_class),        intent(inout) :: a
34    end subroutine
35  end interface
36end module m2
37!---------------------------------------------------------------
38module m3
39  use :: m1
40  use :: m2
41  implicit none
42  private
43  public :: gradient_class
44
45  type, abstract, extends(vector_class) :: gradient_class
46    class(inner_product_class), pointer :: my_inner_product => NULL()
47  contains
48    procedure, non_overridable  :: inquire_inner_product
49    procedure(op_g_v), deferred :: to_vector
50  end type gradient_class
51
52  abstract interface
53    subroutine op_g_v(this,v)
54      import vector_class
55      import gradient_class
56      class(gradient_class), intent(in)    :: this
57      class(vector_class),   intent(inout) :: v
58    end subroutine
59  end interface
60contains
61  function inquire_inner_product (this)
62    class(gradient_class)               :: this
63    class(inner_product_class), pointer :: inquire_inner_product
64
65    inquire_inner_product => this%my_inner_product
66  end function inquire_inner_product
67end module m3
68!---------------------------------------------------------------
69module m4
70  use m3
71  use m2
72  implicit none
73contains
74  subroutine cg (g_initial)
75    class(gradient_class),  intent(in)    :: g_initial
76
77    class(inner_product_class), pointer   :: ip_save
78    ip_save => g_initial%inquire_inner_product()
79  end subroutine cg
80end module m4
81