我可以使用 generics.defaults 比较 Real48 吗？

Question

以下用于比较两个 Real48（6 字节浮点数）的代码编译并运行，但要么生成无意义的结果，要么生成 AV。

program Project44;

{$APPTYPE CONSOLE}
uses
  System.SysUtils,
  System.Generics.Defaults;

begin
  try
    WriteLn(System.Generics.Defaults.TComparer<Real48>.Default.Compare(100.0,100.0));
    WriteLn('all ok, press space');
  except on E:exception do
    WriteLn(e.Message);
  end;
  ReadLn
end.

它应该输出 0，但如果它没有首先炸弹，它会输出 -92 或其他一些不正确的值。

这个bug在最新的XE8中还存在吗？
如果是这样的话，之前有没有报道过，我在 https://quality.embarcadero.com 上找不到任何东西，但如果有更老的 QC，我想参考一下。

终于…… 如何使用 TComparer<something> 比较两个 REAL48 类型？

编辑：
这是我确定的修复方法：

interface
...snip...
[Test]
procedure TestReal48;
...snip...  
    TTest<T> = record
  private
    class var Def: System.Generics.Defaults.IComparer<T>;
    class var F: FastDefaults.TComparison<T>;
  public
    class function Real48Comparison(const Left, Right: T): Integer; static;

implementation

procedure TestDefault.TestReal48;
var
  OldDef: System.Generics.Defaults.IComparer<Real48>;
begin
  OldDef:= TTest<Real48>.Def;
  TTest<Real48>.Def:= System.Generics.Defaults.TComparer<Real48>.Construct(TTest<Real48>.Real48Comparison);
  TTest<Real48>.Test(100.0,100.0);
  TTest<Real48>.Test(100000.0,-10000.0);
  TTest<Real48>.Test(0.0,-10000.0);
  TTest<Real48>.Test(100000.0,0.0);
  TTest<Real48>.Test(0.0,0.0);
  TTest<Real48>.Def:= OldDef;
end;

Answer 1

此缺陷存在于所有版本的编译器中。由于 Real48 在十多年前就被弃用了，我希望 Embarcadero 不会改变这种行为，即使您提交了错误报告。当然，你还是应该提交错误报告，但我不会屏住呼吸等待修复！

您必须构建一个比较器而不是依赖默认值：

var
  Comparer: IComparer<Real48>;

function Real48Comparison(const Left, Right: Real48): Integer;
begin
  if Left < Right then
    Result := -1
  else if Left > Right then
    Result := 1
  else
    Result := 0;
end;

Comparer := System.Generics.Defaults.TComparer<Real48>.Construct(Real48Comparison);

为什么默认的 Real48 比较器如此失败。嗯，从这里开始：

class function TComparer<T>.Default: IComparer<T>;
begin
  Result := IComparer<T>(_LookupVtableInfo(giComparer, TypeInfo(T), SizeOf(T)));
end;

结果是 TypeInfo(Real48) 产生 nil。 Real48 似乎没有可用的类型信息。可能不是一个很大的惊喜。

然后我们到达这里：

function _LookupVtableInfo(intf: TDefaultGenericInterface; info: PTypeInfo; size: Integer): Pointer;
var
  pinfo: PVtableInfo;
begin
  if info <> nil then
  begin
    pinfo := @VtableInfo[intf, info^.Kind];
    Result := pinfo^.Data;
    if ifSelector in pinfo^.Flags then
      Result := TTypeInfoSelector(Result)(info, size);
    if ifVariableSize in pinfo^.Flags then
      Result := MakeInstance(Result, size);
  end
  else
  begin
    case intf of
      giComparer: Result := Comparer_Selector_Binary(info, size);
      giEqualityComparer: Result := EqualityComparer_Selector_Binary(info, size);
    else
      System.Error(reRangeError);
      Result := nil;
    end;
  end;
end;

我们走 else 支路并调用 Comparer_Selector_Binary。所以我们最终执行二进制比较。比较实际上是由这个函数执行的：

function Compare_Binary(Inst: PSimpleInstance; const Left, Right): Integer;
begin
  Result := BinaryCompare(@Left, @Right, Inst^.Size);
end;

调用：

function BinaryCompare(const Left, Right: Pointer; Size: Integer): Integer;
var
  pl, pr: PByte;
  len: Integer;
begin
  pl := Left;
  pr := Right;
  len := Size;
  while len > 0 do
  begin
    Result := pl^ - pr^;
    if Result <> 0 then
      Exit;
    Dec(len);
    Inc(pl);
    Inc(pr);
  end;
  Result := 0;
end;

对实值类型没有用。

至于与 Real48 的 ABI 相关的运行时错误。似乎 Real48 参数总是在堆栈上传递。这与 Compare_Binary.

中无类型参数的使用不兼容

我可以使用 generics.defaults 比较 Real48 吗？

Can I compare Real48 using generics.defaults?

delphi

delphi-xe7

delphi-xe8