1! { dg-do run }
2! Test the fix for PR46897.
3!
4! Contributed by Rouson Damian <rouson@sandia.gov>
5!
6module m0
7  implicit none
8  type component
9    integer :: i = 0
10  contains
11    procedure :: assign0
12    generic :: assignment(=)=>assign0
13  end type
14  type parent
15    type(component) :: foo
16  end type
17  type, extends(parent) :: child
18    integer :: j
19  end type
20contains
21  subroutine assign0(lhs,rhs)
22    class(component), intent(out) :: lhs
23    class(component), intent(in) :: rhs
24    lhs%i = 20
25  end subroutine
26  type(child) function new_child()
27  end function
28end module
29
30module m1
31  implicit none
32  type component1
33    integer :: i = 1
34  contains
35    procedure :: assign1
36    generic :: assignment(=)=>assign1
37  end type
38  type t
39    type(component1) :: foo
40  end type
41contains
42  subroutine assign1(lhs,rhs)
43    class(component1), intent(out) :: lhs
44    class(component1), intent(in) :: rhs
45    lhs%i = 21
46  end subroutine
47end module
48
49module m2
50  implicit none
51  type component2
52    integer :: i = 2
53  end type
54  interface assignment(=)
55    module procedure assign2
56  end interface
57  type t2
58    type(component2) :: foo
59  end type
60contains
61  subroutine assign2(lhs,rhs)
62    type(component2), intent(out) :: lhs
63    type(component2), intent(in) :: rhs
64    lhs%i = 22
65  end subroutine
66end module
67
68program main
69  use m0
70  use m1
71  use m2
72  implicit none
73  type(child) :: infant0
74  type(t) :: infant1, newchild1
75  type(t2) :: infant2, newchild2
76
77! Test the reported problem.
78  infant0 = new_child()
79  if (infant0%parent%foo%i .ne. 20) call abort
80
81! Test the case of comment #1 of the PR.
82  infant1 = newchild1
83  if (infant1%foo%i .ne. 21) call abort
84
85! Test the case of comment #2 of the PR.
86  infant2 = newchild2
87  if (infant2%foo%i .ne. 2) call abort
88end
89
90
91