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    integer, allocatable :: b
12  contains
13    procedure :: assign0
14    generic :: assignment(=) => assign0
15  end type
16  type, extends(component) :: comp2
17    real :: aa
18  end type comp2
19  type parent
20    type(component) :: foo
21    real :: cc
22  end type
23  type p2
24    type(parent) :: x
25  end type p2
26contains
27  elemental subroutine assign0(lhs,rhs)
28    class(component), intent(INout) :: lhs
29    class(component), intent(in) :: rhs
30    lhs%i = 20
31  end subroutine
32end module
33
34program main
35  use m0
36  implicit none
37  type(p2), allocatable :: left
38  type(p2) :: right
39!  print *, right%x%foo%i
40  left = right
41!  print *, left%x%foo%i
42  if (left%x%foo%i /= 20) call abort()
43end
44