一个有意思的问题
文件:m_father.f90module 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 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
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... 可能是编译器差异,这就不好搞了。
页:
[1]