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