1! { dg-do compile }
2!
3! PR 41556: [OOP] Errors in applying operator/assignment to an abstract type
4!
5! Contributed by Damian Rouson <damian@rouson.net>
6
7module abstract_algebra
8  implicit none
9  private
10  public :: rescale
11  public :: object
12
13  type ,abstract :: object
14  contains
15    procedure(assign_interface) ,deferred :: assign
16    procedure(product_interface) ,deferred :: product
17    generic  :: assignment(=) => assign
18    generic  :: operator(*) => product
19  end type
20
21  abstract interface
22    function product_interface(lhs,rhs) result(product)
23      import :: object
24      class(object) ,intent(in)  :: lhs
25      class(object) ,allocatable :: product
26      real          ,intent(in)  :: rhs
27    end function
28    subroutine assign_interface(lhs,rhs)
29      import :: object
30      class(object) ,intent(inout) :: lhs
31      class(object) ,intent(in)    :: rhs
32    end subroutine
33  end interface
34
35contains
36
37  subroutine rescale(operand,scale)
38    class(object)    :: operand
39    real ,intent(in) :: scale
40    operand = operand*scale
41    operand = operand%product(scale)
42  end subroutine
43end module
44