Can I compare Real48 using generics.defaults? - delphi

Question

The following code to compare two Real48's (6-byte float) compiles and runs, but either generates non-nonsensical results or generates a 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.
It should output 0, but if it does not bomb first it outputs -92 or some other incorrect value.
Is this bug still present in the lastest XE8?
And if so, has it been reported before, I cannot find anything on the https://quality.embarcadero.com, but if there's an older QC I would like to refer to that.
Finally....
How do I compare two REAL48 types using TComparer<something>?
EDIT :
this was the fix I settled upon:
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

This defect is present in all versions of the compiler. Since Real48 was deprecated more than a decade ago I would expect that Embarcadero would not change the behaviour, even if you submitted a bug report. Of course, you should still submit a bug report, but I would not hold your breath when waiting for a fix!
You'll have to construct a comparer rather than relying on the default:
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);
Why does the default Real48 comparer fail so hard. Well, it starts here:
class function TComparer<T>.Default: IComparer<T>;
begin
Result := IComparer<T>(_LookupVtableInfo(giComparer, TypeInfo(T), SizeOf(T)));
end;
It transpires that TypeInfo(Real48) yields nil. There would appear to be no type info available for Real48. Probably not a great surprise.
Then we reach here:
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;
We take the else branch and call Comparer_Selector_Binary. So we end up performing a binary comparison. The comparison is actually performed by this function:
function Compare_Binary(Inst: PSimpleInstance; const Left, Right): Integer;
begin
Result := BinaryCompare(#Left, #Right, Inst^.Size);
end;
which calls:
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;
Not going to be useful for a real valued type.
As for the runtime error that relates to the ABI for Real48. It seems that Real48 parameters are always passed on the stack. That is just not compatible with the use of untyped parameters in Compare_Binary.