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.
10 integer, allocatable
:: j(:)
13 generic
:: assignment(=)=>assign0
16 type(component
) :: foo1
18 type, extends(parent
) :: child
20 integer, allocatable
:: l(:)
21 type(component
) :: foo2
24 subroutine assign0(lhs
,rhs
)
25 class(component
), intent(inout
) :: lhs
26 class(component
), intent(in
) :: rhs
27 if (lhs
%i
.eq
. 0) then
32 lhs
%j
= [rhs
%j
, rhs
%j
*2]
35 type(child
) function new_child()
36 new_child
%parent
%foo1
%i
= 20
38 new_child
%parent
%foo1
%j
= [99,199]
39 new_child
%foo2
%j
= [199,299]
40 new_child
%l
= [299,399]
48 type(child
) :: infant0
50 ! Check that the INTENT(INOUT) of assign0 is respected and that the
51 ! correct thing is done with allocatable components.
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
60 ! Now, since the defined assignment depends on whether or not the 'i'
61 ! component is the default initialization value, the result will be
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
70 ! Finally, make sure that normal components of the declared type survive.
71 if (infant0
%k
.ne
. 1001) call abort