1! { dg-do run }
2!
3! PR fortran/57697
4!
5! Further test of typebound defined assignment
6!
7module m0
8  implicit none
9  type component
10    integer :: i = 42
11  contains
12    procedure :: assign0
13    generic :: assignment(=) => assign0
14  end type
15  type parent
16    type(component) :: foo
17  end type
18contains
19  elemental subroutine assign0(lhs,rhs)
20    class(component), intent(INout) :: lhs
21    class(component), intent(in) :: rhs
22    lhs%i = 20
23  end subroutine
24end module
25
26program main
27  use m0
28  implicit none
29  type(parent), allocatable :: left
30  type(parent) :: right
31!  print *, right%foo
32  left = right
33!  print *, left%foo
34  if (left%foo%i /= 20) call abort()
35end
36