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