When comparing two managed records using a inline generic class function with const parameters CopyRecord gets...
When comparing two managed records using a inline generic class function with const parameters CopyRecord gets called on the records.
This causes the pointers inside the records to change and two (previously) equal records to not test equal.
However.....
When creating a simple MVCE I'm unable to reproduce the behavior.
The following code works just fine:
program RTLTestManagedRecords;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils;
type
TCompare = class
class function Compare(const Left, Right: T): integer; static; inline;
end;
TTest = class
private
class var F: TCompare;
public
class function Fast(const Left, Right: T): integer; static;
class procedure Test(const Left, Right: T; const message: string = ''); static;
end;
function BinaryCompare(const Left, Right; Size: NativeInt): integer; forward;
class function TCompare.Compare(const Left, Right: T): integer;
begin
if GetTypeKind(T) = tkRecord then case SizeOf(T) of
0: Result:= 0;
1: Result:= (PByte(@Left)^)- (PByte(@Right)^);
2: Result:= (PWord(@Left)^)- (PWord(@Right)^);
4: Result:= (integer(PCardinal(@Left)^> PCardinal(@Right)^)-
integer(PCardinal(@Left)^< PCardinal(@Right)^));
else Result:= BinaryCompare(Left, Right, SizeOf(T));
end;
end;
{pointermath on}
function BinaryCompare(const Left, Right; Size: NativeInt): integer;
var
i: integer;
L,R: PByte;
begin
L:=@Left;
R:=@Right;
for i:= 0 to Size - 1 do begin
if L[i] <> R[i] then exit(L[i] - R[i]);
end;
Result:= 0;
end;
{$pointermath off}
type
TManagedRec = record
a: integer;
b: string;
end;
var
L,R: TManagedRec;
{ TTest }
class function TTest.Fast(const Left, Right: T): integer;
begin
Result:= F.Compare(Left, Right);
end;
class procedure TTest.Test(const Left, Right: T; const message: string);
begin
try
WriteLn(Format(message,[TTest.Fast(Left,Right)]));
except
WriteLn('Oops');
end;
end;
begin
L.a:= 1;
R.a:= 2;
L.b:= '7878787';
R.b:= '7777777';
TTest.Test(L,L,'Compare(L,L) = %d');
WriteLn(Format('Compare(L,R) = %d',[TCompare.Compare(L,R)]));
WriteLn(Format('Compare(R,L) = %d',[TCompare.Compare(R,L)]));
WriteLn(Format('Compare(R,R) = %d',[TCompare.Compare(R,R)]));
WriteLn(Format('Compare(L,L) = %d',[TCompare.Compare(L,L)]));
ReadLn;
end.
When I run it inside the more complex fastdefaults code it fails because CopyRecord gets called, even though the parameters are declared as const.
Declaring them as const [ref] does not fix the issue.
Removing the inline fixes it, but that removes much of the benefit of the compare function.
*Is anyone able to change/expand the above MVCE so that it bombs just like the larger example does?"
This causes the pointers inside the records to change and two (previously) equal records to not test equal.
However.....
When creating a simple MVCE I'm unable to reproduce the behavior.
The following code works just fine:
program RTLTestManagedRecords;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils;
type
TCompare
class function Compare(const Left, Right: T): integer; static; inline;
end;
TTest
private
class var F: TCompare
public
class function Fast(const Left, Right: T): integer; static;
class procedure Test(const Left, Right: T; const message: string = ''); static;
end;
function BinaryCompare(const Left, Right; Size: NativeInt): integer; forward;
class function TCompare
begin
if GetTypeKind(T) = tkRecord then case SizeOf(T) of
0: Result:= 0;
1: Result:= (PByte(@Left)^)- (PByte(@Right)^);
2: Result:= (PWord(@Left)^)- (PWord(@Right)^);
4: Result:= (integer(PCardinal(@Left)^> PCardinal(@Right)^)-
integer(PCardinal(@Left)^< PCardinal(@Right)^));
else Result:= BinaryCompare(Left, Right, SizeOf(T));
end;
end;
{pointermath on}
function BinaryCompare(const Left, Right; Size: NativeInt): integer;
var
i: integer;
L,R: PByte;
begin
L:=@Left;
R:=@Right;
for i:= 0 to Size - 1 do begin
if L[i] <> R[i] then exit(L[i] - R[i]);
end;
Result:= 0;
end;
{$pointermath off}
type
TManagedRec = record
a: integer;
b: string;
end;
var
L,R: TManagedRec;
{ TTest
class function TTest
begin
Result:= F.Compare(Left, Right);
end;
class procedure TTest
begin
try
WriteLn(Format(message,[TTest
except
WriteLn('Oops');
end;
end;
begin
L.a:= 1;
R.a:= 2;
L.b:= '7878787';
R.b:= '7777777';
TTest
WriteLn(Format('Compare(L,R) = %d',[TCompare
WriteLn(Format('Compare(R,L) = %d',[TCompare
WriteLn(Format('Compare(R,R) = %d',[TCompare
WriteLn(Format('Compare(L,L) = %d',[TCompare
ReadLn;
end.
When I run it inside the more complex fastdefaults code it fails because CopyRecord gets called, even though the parameters are declared as const.
Declaring them as const [ref] does not fix the issue.
Removing the inline fixes it, but that removes much of the benefit of the compare function.
*Is anyone able to change/expand the above MVCE so that it bombs just like the larger example does?"
Comments
Post a Comment