1! { dg-do run }
2! PR48946 - complex expressions involving typebound operators of derived types.
3!
4module field_module
5  implicit none
6  type ,abstract :: field
7  contains
8    procedure(field_op_real) ,deferred :: multiply_real
9    procedure(field_plus_field) ,deferred :: plus
10    procedure(assign_field) ,deferred :: assn
11    generic :: operator(*) => multiply_real
12    generic :: operator(+) => plus
13    generic :: ASSIGNMENT(=) => assn
14  end type
15  abstract interface
16    function field_plus_field(lhs,rhs)
17      import :: field
18      class(field) ,intent(in)  :: lhs
19      class(field) ,intent(in)  :: rhs
20      class(field) ,allocatable :: field_plus_field
21    end function
22  end interface
23  abstract interface
24    function field_op_real(lhs,rhs)
25      import :: field
26      class(field) ,intent(in)  :: lhs
27      real ,intent(in) :: rhs
28      class(field) ,allocatable :: field_op_real
29    end function
30  end interface
31  abstract interface
32    subroutine assign_field(lhs,rhs)
33      import :: field
34      class(field) ,intent(OUT)  :: lhs
35      class(field) ,intent(IN)  :: rhs
36    end subroutine
37  end interface
38end module
39
40module i_field_module
41  use field_module
42  implicit none
43  type, extends (field)  :: i_field
44    integer :: i
45  contains
46    procedure :: multiply_real => i_multiply_real
47    procedure :: plus => i_plus_i
48    procedure :: assn => i_assn
49  end type
50contains
51  function i_plus_i(lhs,rhs)
52    class(i_field) ,intent(in)  :: lhs
53    class(field) ,intent(in)  :: rhs
54    class(field) ,allocatable :: i_plus_i
55    integer :: m = 0
56    select type (lhs)
57      type is (i_field); m = lhs%i
58    end select
59    select type (rhs)
60      type is (i_field); m = rhs%i + m
61    end select
62    allocate (i_plus_i, source = i_field (m))
63  end function
64  function i_multiply_real(lhs,rhs)
65    class(i_field) ,intent(in)  :: lhs
66    real ,intent(in) :: rhs
67    class(field) ,allocatable :: i_multiply_real
68    integer :: m = 0
69    select type (lhs)
70      type is (i_field); m = lhs%i * int (rhs)
71    end select
72    allocate (i_multiply_real, source = i_field (m))
73  end function
74  subroutine i_assn(lhs,rhs)
75    class(i_field) ,intent(OUT)  :: lhs
76    class(field) ,intent(IN)  :: rhs
77    select type (lhs)
78      type is (i_field)
79        select type (rhs)
80          type is (i_field)
81            lhs%i = rhs%i
82        end select         
83      end select
84    end subroutine
85end module
86
87program main
88  use i_field_module
89  implicit none
90  type(i_field) ,allocatable :: u
91  allocate (u, source = i_field (99))
92
93  u = u*2.
94  u = (u*2.0*4.0) + u*4.0
95  u = u%multiply_real (2.0)*4.0
96  u = i_multiply_real (u, 2.0) * 4.0
97  
98  if (u%i .ne. 152064) call abort
99end program
100