Fortran Coder

查看: 60|回复: 3

[面向对象] 一个有意思的问题

[复制链接]

40

帖子

11

主题

0

精华

熟手

F 币
183 元
贡献
120 点
发表于 7 天前 | 显示全部楼层 |阅读模式
文件: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 这真是个有意思的问题。


回复

使用道具 举报

311

帖子

1

主题

0

精华

宗师

F 币
1676 元
贡献
1122 点
发表于 7 天前 | 显示全部楼层
本帖最后由 li913 于 2019-1-11 20:14 编辑

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

QQ截图20190111195835.png

40

帖子

11

主题

0

精华

熟手

F 币
183 元
贡献
120 点
 楼主| 发表于 6 天前 | 显示全部楼层
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...

311

帖子

1

主题

0

精华

宗师

F 币
1676 元
贡献
1122 点
发表于 5 天前 | 显示全部楼层
可能是编译器差异,这就不好搞了。
您需要登录后才可以回帖 登录 | 极速注册

本版积分规则

QQ|捐赠本站|Archiver|关于我们 About Us|群聊|Fcode

GMT+8, 2019-1-18 11:57

Powered by Discuz! X3.2

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表