Delphi 方法的默认泛型比较器返回不正确的结果

在使用建议的方法回答问题时，代码无法添加多个事件处理程序

问题与将方法添加到

tdelegateinpl.Add（）

中的事件列表有关，

TList.IndexOf

方法使用比较方法查找现有方法，结果始终为0-意味着对于TMethod，左和右是相同的。Equals方法使用

TMethod

类型强制转换，并显式比较

TMethod.code

和

TMethod.Data

，其中

Compare

强制转换为始终相同的地址

---

为什么在

TList.IndexOf

中使用

Compare

，而不是

Equals

？

我可以重现这一点，这显然是默认方法比较器中的一个错误

我已经存档了

这是我的密码：

program TMethodComparer;

{$APPTYPE CONSOLE}

uses
  SysUtils, Generics.Collections;

type
  TMyMethod = procedure of object;

type
  TMyClass = class
  published
    procedure P1;
    procedure P2;
    procedure P3;
  end;

{ TMyClass }

procedure TMyClass.P1;
begin
end;

procedure TMyClass.P2;
begin
end;

procedure TMyClass.P3;
begin
end;

var
  List: TList<TMyMethod>;
  MyObject1, MyObject2: TMyClass;

begin
  MyObject1 := TMyClass.Create;
  MyObject2 := TMyClass.Create;
  List := TList<TMyMethod>.Create;
  List.Add(MyObject1.P1);
  List.Add(MyObject1.P2);
  List.Add(MyObject2.P1);
  List.Add(MyObject2.P2);
  Writeln(List.IndexOf(MyObject1.P1));
  Writeln(List.IndexOf(MyObject1.P2));
  Writeln(List.IndexOf(MyObject2.P1));
  Writeln(List.IndexOf(MyObject2.P2));
  Writeln(List.IndexOf(MyObject1.P3));
end.

预期产出

0
0
0
0
0

0
1
2
3
-1

Generics.Defaults

中的默认比较器实现如下：

type
  TMethodPointer = procedure of object;

function Compare_Method(Inst: PSimpleInstance; const Left, Right: TMethodPointer): Integer;
begin
  if PInt64(@Left)^ < PInt64(@Right)^ then
    Result := -1
  else if PInt64(@Left)^ > PInt64(@Right)^ then
    Result := 1
  else
    Result := 0;
end;

List := TList<TMyMethod>.Create(
  TComparer<TMyMethod>.Construct(CompareMyMethod)
);

这确实会带来预期的产出

显然，对于64位目标（即XE2），基于64位整数别名的方法不起作用

因此，为了解决该缺陷，您可以添加以下函数：

function Compare_Method(const Left, Right: TMethod): Integer;
var
  LCode, LData: PByte;
  RCode, RData: PByte;
begin
  LCode := PByte(Left.Code);
  LData := PByte(Left.Data);
  RCode := PByte(Right.Code);
  RData := PByte(Right.Data);
  if LData<RData then
    Result := -1
  else if LData>RData then
    Result := 1
  else if LCode<RCode then
    Result := -1
  else if LCode>RCode then
    Result := 1
  else
    Result := 0;
end;

function CompareMyMethod(const Left, Right: TMyMethod): Integer;
begin
  Result := Compare_Method(TMethod(Left), TMethod(Right))
end;

函数比较法（const Left，Right:TMethod）：整数；
变量
LCode，LData:PByte；
RCode，RData:PByte；
开始
LCode:=PByte（左代码）；
LData:=PByte（左数据）；
RCode:=PByte（右代码）；
RData:=PByte（右数据）；
如果ldatadata那么
结果：=1
否则如果LCodeRCode那么
结果：=1
其他的
结果：=0；
结束；
函数compareMethod（const Left，Right:TMyMethod）：整数；
开始
结果：=比较_方法（t方法（左），t方法（右））
结束；

然后创建如下列表：

type
  TMethodPointer = procedure of object;

function Compare_Method(Inst: PSimpleInstance; const Left, Right: TMethodPointer): Integer;
begin
  if PInt64(@Left)^ < PInt64(@Right)^ then
    Result := -1
  else if PInt64(@Left)^ > PInt64(@Right)^ then
    Result := 1
  else
    Result := 0;
end;

List := TList<TMyMethod>.Create(
  TComparer<TMyMethod>.Construct(CompareMyMethod)
);

List:=TList.Create(
t比较程序构造（比较方法）
);

问题在于此函数：

function Compare_Method(Inst: PSimpleInstance; const Left, Right: TMethodPointer): Integer;
begin
  if PInt64(@Left)^ < PInt64(@Right)^ then
    Result := -1
  else if PInt64(@Left)^ > PInt64(@Right)^ then
    Result := 1
  else
    Result := 0;
end;

---

顺便说一下，对于TMethod类型没有默认的比较器，那么谁编写了正在使用的比较器呢？@Rudy Velthuis:这是标准的Delphi XE库（参见Generics.Defaults.pas-第1070到1094行）是的，我看到了TMethods有一个比较器。但它使用PInt64（左）^等来访问该方法。这适用于Win32，但不适用于Win64，因为在Win64中，一个指针已经是64位了，所以TMethod是128位。@Rudy，你能不能停止使用64位的指针。XE是32位的。那个比较器甚至不能在32位中工作！为什么他们会比较

PInt64（@Left）^

和

PInt64（@Right）^

？分类？它肯定只用于标识目的，因为它被IndexOf使用@Rudy Velthuis-有什么想法吗？但是为什么要在

IndexOf（）

中使用

Compare

，而不应该使用

Equals

？我不明白。（除了可能的错误）@MX4399

IComparer

只有一种方法，

Compare

。这可能是对齐问题吗？也就是说，如果TMethod不是打包记录（我没有检查），那么它实际上可能大于64位…？@MX4399：通用列表使用IComparer处理所有类型的事情。它没有IEqualityComparer引用，AFAIK。它甚至不能在32位Windows中工作，所以这无法解释任何问题。问题涉及仅为32位的XE。我确信，64位目标的XE2代码会有所不同。对不起，我错过了XE标记。我的解决方案应该适用于所有平台，不过。@MX4399 Windows版本与此无关，我们讨论的是Delphi版本。您使用的是32位Delphi。@大卫：不，对于64位目标，AFAICT并没有什么不同。@David，Rudy:找到原因很好。我对QC投了票。让我们希望Embarcadero在此之后为这些集合添加单元测试。

System.Generics.Defaults.pas.1090: if PInt64(@Left)^ < PInt64(@Right)^ then
00447693 8B4510           lea eax,[ebp+$10] // not MOV
00447696 8B5004           mov edx,[eax+$04]
00447699 8B00             mov eax,[eax]
0044769B 8B4D08           lea ecx,[ebp+$08] // not MOV
0044769E 3B5104           cmp edx,[ecx+$04]
004476A1 7506             jnz $004476a9
004476A3 3B01             cmp eax,[ecx]
etc...

function Compare_Method(Inst: PSimpleInstance; const Left, Right: TMethodPointer): Integer;
var
  LCode, LData: PByte;
  RCode, RData: PByte;
begin
  LCode := PByte(TMethod(Left).Code);
  LData := PByte(TMethod(Left).Data);
  RCode := PByte(TMethod(Right).Code);
  RData := PByte(TMethod(Right).Data);
  if LData < RData then
    Result := -1
  else if LData > RData then
    Result := 1
  else if LCode < RCode then
    Result := -1
  else if LCode > RCode then
    Result := 1
  else
    Result := 0;
end;