Generic Comparer по умолчанию для методов возвращает неверные результаты - PullRequest
Новая
       38

Generic Comparer по умолчанию для методов возвращает неверные результаты

5 голосов
/ 15 сентября 2011

При использовании предложенного подхода многоадресного делегата в ответ на реализацию Сигналы и слоты в Delphi в коде не удается добавить более одного обработчика событий.

Проблема связана с добавлением методов в список событий в TDelegateImpl<T>.Add(), метод TList<T>.IndexOf использует метод Compare, чтобы найти существующие методы, и результат всегда равен 0 - это означает, что Left и Right одинаковы для TMethod. Метод Equals использует приведение типа TMethod и явно сравнивает TMethod.Code и TMethod.Data, где Compare приводит к адресу, который всегда одинаков.

Почему Compare используется в TList<T>.IndexOf, а не Equals?

Ответы [ 2 ]

5 голосов
/ 15 сентября 2011

Проблема в этой функции: 

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;

Это сравнивает методы как Int64s.Это не работает, так как @, вероятно, здесь не имеет никакого эффекта.

Представление ЦП подтверждает это: 

System.Generics.Defaults.pas.1089: begin
00447690 55               push ebp
00447691 8BEC             mov ebp,esp
System.Generics.Defaults.pas.1090: if PInt64(@Left)^ < PInt64(@Right)^ then
00447693 8B4510           mov eax,[ebp+$10]
00447696 8B5004           mov edx,[eax+$04]
00447699 8B00             mov eax,[eax]
0044769B 8B4D08           mov ecx,[ebp+$08]
0044769E 3B5104           cmp edx,[ecx+$04]
004476A1 7506             jnz $004476a9
004476A3 3B01             cmp eax,[ecx]
004476A5 7309             jnb $004476b0
004476A7 EB02             jmp $004476ab
004476A9 7D05             jnl $004476b0
System.Generics.Defaults.pas.1091: Result := -1
004476AB 83C8FF           or eax,-$01
004476AE EB21             jmp $004476d1
System.Generics.Defaults.pas.1092: else if PInt64(@Left)^ > PInt64(@Right)^ then
004476B0 8B4510           mov eax,[ebp+$10]
etc...

Чтобы сравнить два TMethods как Int64, это должно быть: 

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...

Это ясно показывает, что PInt64(@Left)^ интерпретируется как PInt64(Left)^.

Надлежащая реализация должна более или менее выглядеть так, как для Delphi 32, так и для Delphi 64: 

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;
5 голосов
/ 15 сентября 2011

Я могу воспроизвести это, и это явно ошибка в компараторе по умолчанию для методов.

Я подал КК # 98942 .

Вот мой код: 

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;

Я могу понять, что это пытается сделать, но с треском проваливается. Я до сих пор не могу понять, как получаются эти броски.

Я считаю, что 32-битная версия Compare_Method должна была быть написана так: 

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

И это приводит к ожидаемому результату.

Очевидно, что для 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;

А затем создайте список следующим образом: 

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