使用重载操作员包装

Question

我正在尝试在自定义类型数组上使用包函数。我已经设置了一个带有重载.eq.类型和接口的小模块。如果我进行简单的比较，重载运算符似乎可以工作，但是在包函数的上下文中使用时，我会出现错误。

!The module
module m_types
  type :: t_property
     character(12) :: key
     logical :: value
  end type t_property
  type(t_property), allocatable, dimension(:) :: properties
  public :: operator(.eq.)
  interface operator(.eq.)
     procedure prop_eq
  end interface operator(.eq.)
contains
  pure function prop_eq(first, second) result(res)
    type(t_property), intent(in) :: first, second
    logical :: res
    if (first%key .eq. second%key) then
       res = .true.
    else
       res = .false.
    end if
  end function prop_eq
end module m_types
! The test program
program textadventure
  use m_types
  implicit none
  type(t_property) :: temp
    allocate(properties(0))
    temp = t_property(key="lit", value=.true.)
    properties = [properties, temp]
    temp = t_property(key="visited", value=.false.)
    properties = [properties, temp]
    temp = t_property(key="lit", value=.false.)
    properties = [properties, temp]
    temp = t_property(key="cold", value=.false.)
    properties = [properties, temp]
    temp = t_property(key="cold", value=.false.)
    properties = [properties, temp]
    print *, properties
    print *,  (properties(4) .eq. temp) ! Succeeds
    print *, size(pack(properties, properties .eq. temp)) ! Fails
    deallocate(properties)
end program textadventure

海湾合作委员会错误消息

Error: Operands of comparison operator ‘.eq.’ at (1) are TYPE(t_property)/TYPE(t_property)

规范说PACK中的掩码应该是我认为我提供的逻辑标量 - 有人可以指出我错在哪里吗？

Answer 1

在掩码的比较中，properties .eq. temp您有两个type(t_property)对象，并且您希望使用函数prop_eq来提供该定义的操作。

但是，第一个操作数properties是一个数组，prop_eq的第一个虚拟参数是一个标量。 因此，没有可用的定义运算符.eq.。 您应该提供一个函数来处理数组第一个参数。 一种方法是使prop_eq元素化。

从.eq.返回数组结果是合适的：PACK的mask=参数应与数组参数一致(并且您不希望它是标量(。

在成功的比较properties(4) .eq. temp中，第一个操作数是标量。

Answer 2

对于那些

感兴趣的人，更正后的代码，它现在按预期打包。

module m_types
  type :: t_property
     character(12) :: key
     logical :: value
  end type t_property
  type(t_property), allocatable, dimension(:) :: properties
  public :: operator(.eq.)
  interface operator(.eq.)
     procedure prop_eq
  end interface operator(.eq.)
contains
  function prop_eq(first, second) result(res)
    type(t_property), intent(in) :: second
    type(t_property), intent(in), dimension(:) :: first
    logical, dimension(:), allocatable :: res
    integer :: i
    allocate(res(0))
    do i=1, size(first)
       if (first(i)%key .eq. second%key) then
          res = [res, .true.]
       else
          res = [res, .false.]
       end if
    end do
  end function prop_eq
end module m_types
program textadventure
  use m_types
  implicit none
  type(t_property) :: temp
    allocate(properties(0))
    temp = t_property(key="cold", value=.false.)
    properties = [properties, temp]
    temp = t_property(key="lit", value=.true.)
    properties = [properties, temp]
    temp = t_property(key="visited", value=.false.)
    properties = [properties, temp]
    temp = t_property(key="lit", value=.false.)
    properties = [properties, temp]
    temp = t_property(key="cold", value=.false.)
    properties = [properties, temp]
    temp = t_property(key="cold", value=.false.)
    properties = [properties, temp]
    print *, size(properties)
    print *,
    print *, pack(properties, mask = properties .eq. temp)
    deallocate(properties)
end program textadventure