I would like clone (deep copy) instance of some object to unlimited polymorphic object.
I am using sourced allocation but it does not do a deep copy. I have tried to overload assignment operator on type but it did not help.
Here is an example program:
module A_m implicit none private type, public :: A_t private real, pointer :: r1 => null() contains procedure :: SetR1 procedure :: GetR1 procedure :: ChangeR1 procedure :: AssignmentOperator generic :: assignment(=) => AssignmentOperator end type A_t integer, protected, public, save :: counter = 0 contains subroutine SetR1(this, r1) class(A_t), intent(inout) :: this real, target, intent(in) :: r1 if (associated(this%r1)) deallocate(this%r1) allocate(this%r1, source=r1) end subroutine SetR1 function GetR1(this) result(r1) class(A_t), intent(inout) :: this real :: r1 r1 = -1 if (associated(this%r1)) r1 = this%r1 end function GetR1 subroutine ChangeR1(this, r1) class(A_t), intent(inout) :: this real, target, intent(in) :: r1 if (associated(this%r1)) this%r1 = r1 end subroutine ChangeR1 subroutine AssignmentOperator(dest, source) class(A_t), intent(out) :: dest class(A_t), intent(in) :: source counter = counter + 1 if (associated(source%r1)) call dest%SetR1(source%r1) end subroutine AssignmentOperator end module A_m program ClonningClassStar use A_m implicit none real, target :: r1 real, target :: anotherR1 type(A_t), target :: a type(A_t), target :: b class(*), pointer :: cUnlimited r1 = 10 anotherR1 = 9 call a%SetR1(r1) call DeepCopyAttempt(cUnlimited, a) ! WORKAROUND 1: workaround to make a deep copy. Yet would like to avoid it.. ! allocate(cUnlimited, mold=a) ! select type(cUnlimited) ! type is (A_t) ! cUnlimited = a ! end select b = a call a%ChangeR1(anotherR1) if (a%GetR1() /= 9) print *, 'error: a value expected to be 9, actual value = ', a%GetR1() if (b%GetR1() /= 10) print *, 'error: b value expected to be 10, actual value = ', b%GetR1() select type(c => cUnlimited) type is (A_t) if (c%GetR1() /= 10) print *, 'error: c value expected to be 10, actual value = ', c%GetR1() end select if (counter /= 2) print *, 'error: assignment operator counter expected to be 2, actual value = ', counter contains subroutine DeepCopyAttempt(dst, source) class(*), pointer, intent(out) :: dst class(*), intent(in) :: source allocate(dst, source=source) end subroutine DeepCopyAttempt end program ClonningClassStar
The program prints two "error" messages, compiler's version is 188.8.131.52 Build 20130607
Is it possible to call user-defined assignment operator when using sourced allocation (see DeepCopyAttempt subroutine, for example)?
One of the option is to use "WORKAROUND 1" from the example program. But it does not work for unlimited polymorphic objects. Say, I want to implement generic container using unlimited polymorphism. I do not know types which will be used in the container, so it is not possible to make deep copies using "WORKAROUND 1".