Deep copy of unlimited polymorphism

[Marat_S_1]

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:

[fortran]

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

[/fortran]

The program prints two "error" messages, compiler's version is 13.1.3.198 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". 

[Steven_L_Intel1]

I think it does make the deep copy, However, you seem to be expecting that your defined assignment procedure will be called as a result of the ALLOCATE with SOURCE= - that's not what the standard says. I admit that the wording here is rather obscure, but it says "the value of allocate-object becomes the value provided". Note that it does not say "according to the rules of intrinsic assignment" nor that defined assignment is used. It literally makes a copy, including a copy of any pointers.

I tried this program with 14.0.2 and got the results I expected.