lookbook 发表于 2019-1-11 14:55:20

一个有意思的问题

文件: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 发表于 2019-1-11 19:59:31

本帖最后由 li913 于 2019-1-11 20:14 编辑

但“=”载入是t_father里的eqaul,而不是interface里面的“=”并没有载入。
上面这句话有问题,我试了你的代码,得到恰恰相反的结果。
fortran 不能将子类赋值给父类(ivf2017测试不行,后续版本不清楚),所以 t_father 中的‘=’只用于被继承,实际永远用不到。
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 发表于 2019-1-12 15:25:42

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 发表于 2019-1-13 16:16:24

可能是编译器差异,这就不好搞了。
页: [1]
查看完整版本: 一个有意思的问题