一个有意思的问题

lookbook

文件：m_father.f90

module m_father
  implicit none
  type t_father
     real :: x,y
   contains
     procedure,pass(this),private :: equal
     generic,public :: assignment(=)=>equal
  end type t_father

  private equal
contains
  subroutine equal(this,other)
    implicit none
    class(t_father),intent(inout) :: this
    class(t_father),intent(in) :: other

    this%x=other%x
    this%y=other%y
  end subroutine equal
end module m_father

module m_a
  use m_father
  implicit none


文件：m_a.f90
  type,extends(t_father) :: t_a
     real :: z
   contains
     procedure,pass(this),private :: equal
  end type t_a
  private equal
contains
  subroutine equal(this,other)
    implicit none
    class(t_a),intent(inout) :: this
    class(t_father),intent(in) :: other

    select type(other)
    class is(t_a)
       this%x=other%x
       this%y=other%y
       this%z=other%z
    class is(t_father)
       this%x=other%x
       this%y=other%y
    class default
       print*,"erro"
    end select
  end subroutine equal
end module m_a

文件： m_b.f90

module m_b
  use m_father
  implicit none

  type,extends(t_father) :: t_b
     double precision :: z
   contains
     procedure,pass(this),private :: equal
  end type t_b
  private equal
contains
  subroutine equal(this,other)
    implicit none
    class(t_b),intent(inout) :: this
    class(t_father),intent(in) :: other

    select type(other)
    class is(t_b)
       this%x=other%x
       this%y=other%y
       this%z=other%z
    class is(t_father)
       this%x=other%x
       this%y=other%y
    class default
       print*,"erro"
    end select
  end subroutine equal
end module m_b

文件：m_interface.f90

module m_interface
  use m_a
  use m_b
  implicit none
  interface assignment(=)
     procedure equal1
     procedure equal2
  end interface

  private equal1,equal2
contains
  subroutine equal1(this,other)
    implicit none
    type(t_a),intent(inout) :: this
    type(t_b),intent(in) :: other
    this%x=other%x
    this%y=other%y
    this%z=real(other%z,kind(0.))
  end subroutine equal1

  subroutine equal2(this,other)
    implicit none
    type(t_b),intent(inout) :: this
    type(t_a),intent(in) :: other
    this%x=other%x
    this%y=other%y
    this%z=real(other%z,kind(0d0))
  end subroutine equal2
end module m_interface

=======================================
t_father是t_a和t_b的父类，
里面继承了equal这种方法，
又定义了m_interface这个模块，
里面直接定义了t_a和t_b相等，
在main.f90中使用了 “=”，原先以为会造成混乱，
但目前来看，并不会出现编译的错误，但“=”载入是t_father里的eqaul，而不是interface里面的“=”并没有载入。

有没有办法载入interface中的“=”号，by the way 这真是个有意思的问题。

li913

但“=”载入是t_father里的eqaul，而不是interface里面的“=”并没有载入。
上面这句话有问题，我试了你的代码，得到恰恰相反的结果。
fortran 不能将子类赋值给父类（ivf2017测试不行，后续版本不清楚），所以 t_father 中的‘=’只用于被继承，实际永远用不到。

[Fortran] syntaxhighlighter_viewsource syntaxhighlighter_copycode

module m_father
  implicit none
  type t_father
     real :: x,y
   contains
     procedure,pass(this),public :: equal
     generic,public :: assignment(=) => equal
  end type t_father
  private equal
contains
  subroutine equal(this,other)
    implicit none
    class(t_father),intent(inout) :: this
    class(t_father),intent(in) :: other
    print*,'t_father'
  end subroutine equal
end module m_father

module m_a
  use m_father
  implicit none

  type,extends(t_father) :: t_a
     real :: z
   contains
     procedure,pass(this),public :: equal
  end type t_a
  private equal
contains
  subroutine equal(this,other)
    implicit none
    class(t_a),intent(inout) :: this
    class(t_father),intent(in) :: other
    print*,'t_a'
  end subroutine equal
end module m_a

module m_b
  use m_father
  implicit none
  type,extends(t_father) :: t_b
     double precision :: z
   contains
     procedure,pass(this),public :: equal
  end type t_b
  private equal
contains
  subroutine equal(this,other)
    implicit none
    class(t_b),intent(inout) :: this
    class(t_father),intent(in) :: other
    print*,'t_b'
  end subroutine equal
end module m_b

module m_interface
  use m_a
  use m_b
  implicit none
  interface assignment(=)
     procedure equal1
     procedure equal2
  end interface
  private equal1,equal2
contains
  subroutine equal1(this,other)
    implicit none
    type(t_a),intent(inout) :: this
    type(t_b),intent(in) :: other
    print*,'equal1'
  end subroutine equal1

  subroutine equal2(this,other)
    implicit none
    type(t_b),intent(inout) :: this
    type(t_a),intent(in) :: other
    print*,'equal2'
  end subroutine equal2
  end module m_interface
  
module m_c
  use m_b
  implicit none
  type,extends(t_b) :: t_c
     integer i
   contains
     procedure,pass(this),public :: equal
  end type t_c
  private equal
contains
  subroutine equal(this,other)
    implicit none
    class(t_c),intent(inout) :: this
    class(t_father),intent(in) :: other
    print*,'t_c'
  end subroutine equal
end module m_c
  
  program test
  use m_a
  use m_b
  use m_father
  use m_c
  use m_interface
  type(t_father) f
  type(t_a) a
  type(t_b) b
  type(t_c) c !c是b的子类
  call f%equal(a)  !调用type中的函数
  call a%equal(b)  !调用type中的函数
  !f=a   !出错，不能将子类赋值给父类
  !b=c  !出错，不能将子类赋值给父类
  a=b !重载，调用equal1
  b=a !重载，调用equal2
  c=b !调用type中的函数
  a=f !调用type中的函数
  pause
  end
  

lookbook

li913 发表于 2019-1-11 19:59
但“=”载入是t_father里的eqaul，而不是interface里面的“=”并没有载入。
上面这句话有问题，我试了你的 ...

我的表述确实可能有问题，但是gfortran确实可以编译父类=子类，
代码如下：
program main
  use m_father
  use m_a
  use m_b
  use m_interface
  implicit none

  type(t_father) :: father
  type(t_a),pointer :: temp1=>null()
  type(t_b) :: temp2

  father%x=10.
  father%y=20.

  temp2=father
  print*,temp2

  allocate(temp1)
  temp1%x=0.
  temp1%y=0.
  temp1%z=0.

  temp2%x=1.
  temp2%y=2.
  temp2%z=3d0
  temp1 = temp2
  print*,temp1

  father=temp1
  print*,father

  deallocate(temp1)
end program main

结果：

t_b
   10.0000000       20.0000000       0.0000000000000000
t_a
   1.00000000       2.00000000       0.00000000
father
   1.00000000       2.00000000
finalizer...

li913

可能是编译器差异，这就不好搞了。