Fortran中如何在扩展类型复制赋值中调用父类复制赋值？

要解决扩展类型复制赋值时调用父类逻辑的问题，核心是避免接口歧义同时保证类型匹配，以下是两种可行方案：

方案1：直接访问父类分量调用父类赋值子程序 #

这种方式无需依赖类型绑定，通过显式传递对象的父类分量来保证类型匹配，同时避免全局接口的歧义。

修改后的代码： #

module types

implicit none

type, public :: square
    real(8) :: length
end type

type, extends(square), public :: squareColor
    integer :: r, g, b
end type 

interface assignment(=)
    module procedure :: copySquare
    module procedure :: copySquareColorDesired
end interface

contains

! 父类赋值子程序：仅处理square类型，避免接口歧义
subroutine copySquare( copyTo, copyFrom )
    type(square), intent(out) :: copyTo
    type(square), intent(in)  :: copyFrom
    
    copyTo%length = copyFrom%length
end subroutine copySquare

! 子类赋值子程序：调用父类逻辑并扩展
subroutine copySquareColorDesired( copyTo, copyFrom )
    type(squareColor), intent(out) :: copyTo
    type(squareColor), intent(in)  :: copyFrom
    
    ! 传递父类分量调用父类赋值，保证类型匹配
    call copySquare( copyTo%square, copyFrom%square )
    
    ! 处理子类独有的成员
    copyTo%r = copyFrom%r
    copyTo%g = copyFrom%g
    copyTo%b = copyFrom%b
end subroutine copySquareColorDesired

end module types

program extendAssignment

use types
implicit none

type(squareColor) :: squareColor1, squareColor2

squareColor1%length = 5
squareColor1%r = 120
squareColor1%g = 200
squareColor1%b = 250

squareColor2 = squareColor1

print *, squareColor2%length, squareColor2%r, squareColor2%g, squareColor2%b

end program

关键说明： #

• 父类赋值子程序的哑元使用type(square)而非class(square)，确保仅匹配父类类型的赋值操作，避免与子类的赋值子程序产生接口歧义。
• 在子类赋值中，通过copyTo%square访问对象的父类分量，传递给父类赋值子程序，完美解决类型不匹配问题，同时复用父类的赋值逻辑。

方案2：使用类型绑定的赋值操作符（面向对象风格） #

这种方式利用Fortran的类型绑定机制，让子类继承父类的赋值逻辑，同时扩展自身的操作，更符合面向对象的设计思想。

修改后的代码： #

module types

implicit none

type, public :: square
    real(8) :: length
contains
    ! 类型绑定的父类赋值操作符
    procedure :: assign_square => copySquare
    generic :: assignment(=) => assign_square
end type

type, extends(square), public :: squareColor
    integer :: r, g, b
contains
    ! 类型绑定的子类赋值操作符
    procedure :: assign_squarecolor => copySquareColorDesired
    generic :: assignment(=) => assign_squarecolor
end type 

contains

subroutine copySquare( copyTo, copyFrom )
    class(square), intent(out) :: copyTo
    class(square), intent(in)  :: copyFrom
    
    ! 仅处理父类类型的输入，避免意外类型匹配
    select type(copyFrom)
        type is(square)
            copyTo%length = copyFrom%length
        class default
            error stop "Unsupported type for square assignment"
    end select
end subroutine copySquare

subroutine copySquareColorDesired( copyTo, copyFrom )
    class(squareColor), intent(out) :: copyTo
    class(squareColor), intent(in)  :: copyFrom
    
    ! 调用父类的类型绑定赋值操作
    call copyTo%square%assign_square(copyFrom%square)
    ! 也可以直接使用赋值语法：copyTo%square = copyFrom%square
    
    ! 处理子类独有的成员
    copyTo%r = copyFrom%r
    copyTo%g = copyFrom%g
    copyTo%b = copyFrom%b
end subroutine copySquareColorDesired

end module types

program extendAssignment

use types
implicit none

type(squareColor) :: squareColor1, squareColor2

squareColor1%length = 5
squareColor1%r = 120
squareColor1%g = 200
squareColor1%b = 250

squareColor2 = squareColor1

print *, squareColor2%length, squareColor2%r, squareColor2%g, squareColor2%b

end program

关键说明： #

• 通过contains块为类型绑定赋值操作符，子类可以继承父类的赋值逻辑，同时通过自身的类型绑定操作符扩展功能。
• 父类的赋值子程序使用class(square)哑元，但通过select type限制仅处理父类类型的输入，避免与子类的操作产生歧义。
• 子类中通过copyTo%square访问父类部分，调用父类的绑定操作，保证逻辑复用。

内容的提问来源于stack exchange，提问作者nikost