下面的代码比较两个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
或其他一些不正确的值。最新的XE8中仍然存在此错误吗?
如果是这样,以前是否有报告,我在https://quality.embarcadero.com上找不到任何内容,但是如果有较旧的QC,我想参考一下。
最后....
如何使用
REAL48
比较两种TComparer<something>
类型?编辑:
这是我确定的解决方法:
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;
最佳答案
在所有版本的编译器中都存在此缺陷。由于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
中无类型参数的使用不兼容。