3 ! Test the fix for PR71798 in which the result of 'create_mytype'
4 ! was not being finalized after the completion of the assignment
7 ! Contributed by Jonathan Hogg <jhogg41@gmail.com>
17 procedure
:: mytype_assign
18 generic
:: assignment(=) => mytype_assign
23 subroutine mytype_assign(this
, other
)
24 class(mytype
), intent(inout
) :: this
25 class(mytype
), intent(in
) :: other
29 end subroutine mytype_assign
31 subroutine mytype_final(this
)
34 if (this
%idx
/= 0) stop 1 ! finalize 'create_mtype' result
35 end subroutine mytype_final
37 type(mytype
) function create_mytype()
38 create_mytype
%idx
= next
40 end function create_mytype
51 if (x
%idx
/= 1) stop 2 ! Defined assignment failed
52 if (next
/= 3) stop 3 ! Used to give 2 because finalization did not occur