3

我想要一个派生类型a，它是空的。从这个派生类型，我想定义更多的扩展类型。假设所有这些类型扩展都包含一些generic过程名称value，即value => valuea1，value => valuea2等。

如果我想将 a 类的变量传递给其他过程，我需要用class(a). 但是，如果我这样做，那么引用valuedummy 参数会导致编译失败，因为类 a 实际上是空的——只有类型扩展包含该过程。

我大概可以通过value在 a 的类型定义中调用一些过程来解决这个问题（然后在扩展中覆盖）。但是，鉴于我不想声明任何类型为 a 的对象，这似乎很混乱。有可能解决这个问题吗？

4

2 回答 2

3

是的，您甚至可以为类型声明类型绑定过程abstract。它可以是一个真正的类型绑定过程，或者只是一个abstract interface.

type, abstract :: a
contains
  procedure :: valuea1, valuea2
  generic value :: value => valuea1, valuea2
end type


abstract interface
  ! the headers of valuea1, valuea2 here
  ! they should have a passed dummy argument class(a)
  ! and some other argument for the generic resolution
  ! for example:

  subroutine valua1(self, x)
    class(a), intent(in) :: self
    real, intent(inout) :: x
  end subroutine

  subroutine valua2(self, x)
    class(a), intent(in) :: self
    integer, intent(inout) :: x
  end subroutine

end interface

这样您就不能type(a)创建value.

于 2014-03-11T19:35:37.670 回答
2

类似于@VladimirF 的回答，但请您澄清一下

我实际上并不需要通用分辨率；valuea1 和 valuea2 接受相同类型的参数来解决我想到的问题，我只想绑定到一个类型扩展中的 valuea1 和另一种类型扩展中的 valuea2。

那么，这里的基本（抽象）类型定义了一个延迟类型绑定过程value()，其中一个接口class(a)作为传递的参数。可以添加其他参数。每个扩展类型都用自己的过程定义/覆盖这个类型绑定过程。

这意味着在我们的最终子程序调用test_sub中，class(a)虚拟参数确实有一个%value().

module types

! The base type
  type, abstract :: a
   contains
     procedure(value_if), deferred :: value
  end type a

! The interface for the type-bound procedures
  abstract interface
     subroutine value_if(var)
       import a
       class(a) var
     end subroutine value_if
  end interface

! The extending types, overriding the value subroutine

  type, extends(a) :: a1
   contains
     procedure :: value => value_a1
  end type a1

  type, extends(a) :: a2
   contains
     procedure :: value => value_a2
  end type a2

contains

  subroutine value_a1(var)
    class(a1) var
    print*, "Value of a1"
  end subroutine value_a1

  subroutine value_a2(var)
    class(a2) var
    print*, "Value of a2"
  end subroutine value_a2

end module types


program test

  use types

  type(a1) x
  type(a2) y

  call x%value
  call y%value

  call test_sub(x)
  call test_sub(y)

contains

  subroutine test_sub(var)
    class(a) var
    call var%value  ! This is defined
  end subroutine test_sub

end program test

这会产生输出

a1
的值 a2
的值 a1
的值 a2 的值

于 2014-03-11T21:00:48.227 回答