1! { dg-do run }
2! PR51634 - Handle allocatable components correctly in expressions 
3! involving typebound operators. From comment 2 of PR but using
4! classes throughout.
5!
6! Reported by Tobias Burnus  <burnus@gcc.gnu.org>
7! 
8module soop_stars_class
9  implicit none
10  type soop_stars
11    real, dimension(:), allocatable :: position,velocity
12  contains
13    procedure :: total
14    procedure :: mult
15    procedure :: assign
16    generic :: operator(+) => total
17    generic :: operator(*) => mult
18    generic :: assignment(=) => assign
19  end type
20contains
21  function mult(lhs,rhs)
22    class(soop_stars) ,intent(in) :: lhs
23    real ,intent(in) :: rhs
24    class(soop_stars), allocatable :: mult
25    type(soop_stars) :: tmp
26    tmp = soop_stars (lhs%position*rhs, lhs%velocity*rhs)
27    allocate (mult, source = tmp)
28  end function
29
30  function total(lhs,rhs)
31    class(soop_stars) ,intent(in) :: lhs,rhs
32    class(soop_stars), allocatable :: total
33    type(soop_stars) :: tmp
34    tmp = soop_stars (lhs%position + rhs%position, &
35                      lhs%velocity + rhs%velocity)
36    allocate (total, source = tmp)
37  end function
38
39  subroutine assign(lhs,rhs)
40    class(soop_stars), intent(in) :: rhs
41    class(soop_stars), intent(out) :: lhs
42    lhs%position = rhs%position
43    lhs%velocity = rhs%velocity
44  end subroutine
45end module
46
47program main
48  use soop_stars_class ,only : soop_stars
49  implicit none
50  class(soop_stars), allocatable :: fireworks
51  real :: dt
52  allocate (fireworks, source = soop_stars ([1,2,3], [4,5,6]))
53  dt = 5
54  fireworks = fireworks + fireworks*dt
55  if (any (fireworks%position .ne. [6, 12, 18])) call abort
56  if (any (fireworks%velocity .ne. [24, 30, 36])) call abort
57end program
58