#872. Another compilation bug in Sydney under 64 bit

unit tcOldObject5;

interface

uses
 TestFrameWork
;

type
 TtcOldObject5 = class(TTestCase)
  published
   procedure DoIt;
 end;//TtcOldObject5

 Tl3_PointUnion = packed record
  Case Byte of
   0: (X: Integer; Y: Integer);
 end;//Tl3_PointUnion

 TOldObject1 = object
  private
   P: Tl3_PointUnion;
  public
   property X: Integer
    read P.X
    write P.X;
 end;//TOldObject1

function IntFunc(aValue: Integer): Integer;
function ObjFunc(const anObj: TOldObject1): Integer;

implementation

function IntFunc(aValue: Integer): Integer;
begin
 Result := aValue;
end;//IntFunc

function ObjFunc(const anObj: TOldObject1): Integer;
begin
 Result := IntFunc(anObj.X);
end;//IntFunc

procedure TtcOldObject5.DoIt;
const
 cValue = 1024;
var
 l_O1 : TOldObject1;
begin
 l_O1.X := cValue;
 Self.CheckTrue(l_O1.X = cValue);
 Self.CheckTrue(IntFunc(l_O1.X) = cValue);
 Self.CheckFalse(ObjFunc(l_O1) = cValue); // Ooops !
end;//TtcOldObject5.DoIt

initialization
 TestFrameWork.RegisterTest(TtcOldObject5.Suite);
end.

#871. Compilation bug in Sydney under 64 bit

https://quality.embarcadero.com/browse/RSP-31389

Code with bug:

unit tcOldObject1;

interface

uses
 TestFrameWork
;

type
 TtcOldObject1 = class(TTestCase)
  published
   procedure DoIt;
 end;//TtcOldObject1

 TOldObject1 = object
  public
   rF: Pointer;
 end;//TOldObject1

 TOldObject2 = object
  public
   rF: TOldObject1;
 end;//TOldObject2

function TOldObject2_C(const anObj: TOldObject1): TOldObject2;

implementation

function TOldObject2_C(const anObj: TOldObject1): TOldObject2;
begin
 // - here lost pointer dereference
 // Compiler makes the code:
 (*
 push rbp
 sub rsp,$10
 mov rbp,rsp
 mov [rbp+$20],rcx
 mov rax,[rbp+$20]
 mov [rbp+$08],rax
 mov rax,[rbp+$08]
 lea rsp,[rbp+$10]
 pop rbp
 ret
 *)
 // But the correct one is:
 (*
 push rbp
 sub rsp,$10
 mov rbp,rsp
 mov [rbp+$20],rcx
 mov rax,[rbp+$20]
 mov rax,[rax]
 mov [rbp+$08],rax
 mov rax,[rbp+$08]
 lea rsp,[rbp+$10]
 pop rbp
 ret
 *)
 // Lost instruction:
 (*
 mov rax,[rax]
 *)
 // - dereference pointer to anObj lost !!!
 Result.rF := anObj;
end;//TOldObject2_C

procedure TtcOldObject1.DoIt;
var
 l_O1 : TOldObject1;
 l_O2 : TOldObject2;
begin
 l_O1.rF := TypeInfo(Integer);
 l_O2.rF := l_O1;
 Self.Check(l_O2.rF.rF = l_O1.rF); // Right !
 l_O2 := TOldObject2_C(l_O1);
 Self.CheckFalse(l_O2.rF.rF = l_O1.rF); // Ooops !
 Self.CheckTrue(l_O2.rF.rF = @l_O1.rF); // Ooops !
end;//TtcOldObject1.DoIt

initialization
 TestFrameWork.RegisterTest(TtcOldObject1.Suite);
end.

Code without bug:

unit tcRecord1;

interface

uses
 TestFrameWork
;

type
 TtcRecord1 = class(TTestCase)
  published
   procedure DoIt;
 end;//TtcRecord1

 TRecord1 = record
  public
   rF: Pointer;
 end;//TRecord1

 TRecord2 = record
  public
   rF: TRecord1;
 end;//TRecord2

function TRecord2_C(const anObj: TRecord1): TRecord2;

implementation

function TRecord2_C(const anObj: TRecord1): TRecord2;
begin
 Result.rF := anObj;
end;//TRecord2_C

procedure TtcRecord1.DoIt;
var
 l_O1 : TRecord1;
 l_O2 : TRecord2;
begin
 l_O1.rF := TypeInfo(Integer);
 l_O2.rF := l_O1;
 Self.Check(l_O2.rF.rF = l_O1.rF); // Right !
 l_O2 := TRecord2_C(l_O1);
 Self.CheckTrue(l_O2.rF.rF = l_O1.rF); // Right !
 Self.CheckFalse(l_O2.rF.rF = @l_O1.rF); // Right !
end;//TtcRecord1.DoIt

initialization
 TestFrameWork.RegisterTest(TtcRecord1.Suite);
end.