1! { dg-do run }
2! Test the fix for PR46897. defined_assignment_1.f90 checks that the PR
3! testcases run correctly, this checks that other requirements of the
4! standard are satisfied.
5!
6module m0
7  implicit none
8  type component
9    integer :: i = 0
10    integer, allocatable :: j(:)
11  contains
12    procedure :: assign0
13    generic :: assignment(=)=>assign0
14  end type
15  type parent
16    type(component) :: foo1
17  end type
18  type, extends(parent) :: child
19    integer :: k = 1000
20    integer, allocatable :: l(:)
21    type(component) :: foo2
22  end type
23contains
24  subroutine assign0(lhs,rhs)
25    class(component), intent(inout) :: lhs
26    class(component), intent(in) :: rhs
27    if (lhs%i .eq. 0) then
28      lhs%i = rhs%i
29      lhs%j = rhs%j
30    else
31      lhs%i = rhs%i*2
32      lhs%j = [rhs%j, rhs%j*2]
33    end if
34  end subroutine
35  type(child) function new_child()
36    new_child%parent%foo1%i = 20
37    new_child%foo2%i = 21
38    new_child%parent%foo1%j = [99,199]
39    new_child%foo2%j = [199,299]
40    new_child%l = [299,399]
41    new_child%k = 1001
42  end function
43end module
44
45program main
46  use m0
47  implicit none
48  type(child) :: infant0
49
50! Check that the INTENT(INOUT) of assign0 is respected and that the
51! correct thing is done with allocatable components.
52  infant0 = new_child()
53  if (infant0%parent%foo1%i .ne. 20) call abort
54  if (infant0%foo2%i .ne. 21) call abort
55  if (any (infant0%parent%foo1%j .ne. [99,199])) call abort
56  if (any (infant0%foo2%j .ne. [199,299])) call abort
57  if (infant0%foo2%i .ne. 21) call abort
58  if (any (infant0%l .ne. [299,399])) call abort
59
60! Now, since the defined assignment depends on whether or not the 'i'
61! component is the default initialization value, the result will be
62! different.
63  infant0 = new_child()
64  if (infant0%parent%foo1%i .ne. 40) call abort
65  if (any (infant0%parent%foo1%j .ne. [99,199,198,398])) call abort
66  if (any (infant0%foo2%j .ne. [199,299,398,598])) call abort
67  if (infant0%foo2%i .ne. 42) call abort
68  if (any (infant0%l .ne. [299,399])) call abort
69
70! Finally, make sure that normal components of the declared type survive.
71  if (infant0%k .ne. 1001) call abort
72end
73
74
75