* Invoke for record methods, refactoring method rtti by Lipinast Lekrisov

packages/rtl-objpas/tests/tests.rtti.attrtypes2.pp

@@ -32,7 +32,7 @@ type
     property TestIProp[i1, i2: Integer]: Integer read Offset;
     constructor Create(a1, a2: Integer); overload;
     constructor Create(rec: TTestAttr2Record); overload;
-    class function StaticFunc(d: Double; p: TPoint; r: TRect): string; static;
+    class function StaticFunc(d: integer; p: TPoint; r: TRect): string; static;
   end;
 
   TTestAttr2Class = class
@@ -88,7 +88,7 @@ begin
   fa2 := rec.fa2;
 end;
 
-class function TTestAttr2Record.StaticFunc(d: Double; p: TPoint; r: TRect): string;
+class function TTestAttr2Record.StaticFunc(d: integer; p: TPoint; r: TRect): string;
 begin
   Result := 'experiment_'+d.ToString+'_'+p.X.ToString+'_'+p.Y.ToString+'_'+r.Left.ToString+'_'+r.Top.ToString+'_'+r.Right.ToString+'_'+r.Bottom.ToString;
 end;

packages/rtl-objpas/tests/tests.rtti.invoke.pas

@@ -14,7 +14,9 @@ uses
 {$ELSE FPC}
   TestFramework,
 {$ENDIF FPC}
+  types,
   sysutils, typinfo, Rtti,
+  tests.rtti.attrtypes2,
   tests.rtti.invoketypes,
   Tests.Rtti.Util;
 
@@ -288,8 +290,30 @@ type
     Procedure TestInvokeConstructor;
   end;
 
+  { TTestRecordMethodInvoke }
+
+  TTestRecordMethodInvoke = class(TTestInvokeBase)
+  private
+    Fctx: TRttiContext;
+    recType : TRttitype;
+    testRec, testRec2: TTestAttr2Record;
+    tv_rec : TValue;
+  Protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+  Published
+    Procedure TestCreate;
+    procedure TestCreate2;
+    procedure TestCreate3;
+    procedure TestCreate4;
+    procedure TestOffset1;
+    procedure TestOffset2;
+    procedure TestStaticFunc;
+  end;
+
 implementation
 
+
 { ----------------------------------------------------------------------
   Auxiliary methods to test
   ----------------------------------------------------------------------}
@@ -2826,6 +2850,99 @@ begin
   CheckEquals('In test',P.DoTest,'Correct result when called as parent class');
 end;
 
+{ TTestRecordMethodInvoke }
+
+procedure TTestRecordMethodInvoke.SetUp;
+begin
+  inherited SetUp;
+  Fctx:=TRttiContext.Create(False);
+  recType:=FCtx.GetType(TypeInfo(TTestAttr2Record));
+  testRec:=Default(TTestAttr2Record);
+  testRec2:=Default(TTestAttr2Record);
+  tv_rec:=Default(TValue);
+end;
+
+procedure TTestRecordMethodInvoke.TearDown;
+begin
+  inherited TearDown;
+end;
+
+procedure TTestRecordMethodInvoke.TestCreate;
+
+begin
+
+  testRec.fa:=60;
+  testRec.fa2:=80;
+  testRec.fa3:=90;
+
+  TValue.Make(@testRec, TypeInfo(TTestAttr2Record), tv_rec);
+  testRec2 := TTestAttr2Record(recType.GetMethods('Create')[0].Invoke(tv_rec, [111, 222]).GetReferenceToRawData^);
+  AssertTrue( 'Original TTestRecord is broken', (testRec.fa = 60) and (testRec.fa2 = 80));
+  AssertTrue( 'New TTestRecord is incorrect', (testRec2.fa = 111) and (testRec2.fa2 = 222));
+end;
+
+procedure TTestRecordMethodInvoke.TestCreate2;
+begin
+  testRec.fa:=60;
+  testRec.fa2:=80;
+  testRec.fa3:=90;
+  recType.GetMethod('Create').Invoke(@testRec, [333, 444]);
+  AssertTrue('Updated TTestRecord is incorrect',(testRec.fa = 333) and (testRec.fa2 = 444) and (testRec.fa3 = 90));
+end;
+
+procedure TTestRecordMethodInvoke.TestCreate3;
+begin
+  testRec.fa:=111;
+  testRec.fa2:=222;
+  TValue.Make(@testRec, TypeInfo(TTestAttr2Record), tv_rec);
+  testRec := TTestAttr2Record(recType.GetMethods('Create')[1].Invoke(TValue.Empty, [tv_rec]).GetReferenceToRawData^);
+  AssertTrue('Created from nothing TTestRecord is incorrect', (testRec.fa = 111) and (testRec.fa2 = 222));
+end;
+
+procedure TTestRecordMethodInvoke.TestCreate4;
+
+begin
+  testRec.fa:=111;
+  testRec.fa2:=222;
+  TValue.Make(@testRec, TypeInfo(TTestAttr2Record), tv_rec);
+  testRec := TTestAttr2Record(recType.GetMethods('Create')[1].Invoke(@testRec, [tv_rec]).GetReferenceToRawData^);
+  // tv_rec was modified by reference by the first constructor
+  AssertTrue( 'Created from nothing TTestRecord is incorrect',(testRec.fa = 111) and (testRec.fa2 = 222));
+end;
+
+procedure TTestRecordMethodInvoke.TestOffset1;
+
+begin
+  testRec.fa:=111;
+  testRec.fa2:=222;
+  AssertTrue('Result of Offset in incorrect (by pointer)',recType.GetMethod('Offset').Invoke(@testRec, [12, 15]).AsInteger = 360);
+  AssertTrue('Offset of original TTestRecord is incorrect (by pointer)',(testRec.fa = 123) and (testRec.fa2 = 237));
+end;
+
+procedure TTestRecordMethodInvoke.TestOffset2;
+
+begin
+  testRec.fa:=111;
+  testRec.fa2:=222;
+  TValue.Make(@testRec, TypeInfo(TTestAttr2Record), tv_rec);
+  AssertTrue('Result of Offset in incorrect (by TValue)',recType.GetMethod('Offset').Invoke(tv_rec, [12, 15]).AsInteger = 360);
+end;
+
+procedure TTestRecordMethodInvoke.TestStaticFunc;
+
+var
+  pnt: TPoint;
+  rect: TRect;
+  tvp, tvr, exp: TValue;
+
+begin
+  pnt := TPoint.Create(45, 89);
+  rect := TRect.Create(19, 28, 37, 26);
+  TValue.Make(@pnt, TypeInfo(TPoint), tvp);
+  TValue.Make(@rect, TypeInfo(TRect), tvr);
+  AssertEquals('Static call with string return is incorrect','experiment_460_45_89_19_28_37_26',recType.GetMethod('StaticFunc').Invoke(TValue.Empty, [460, tvp, tvr]).AsString);
+end;
+
 begin
 {$ifdef fpc}
   RegisterTest(TTestInvoke);
@@ -2839,6 +2956,7 @@ begin
   RegisterTest(TTestInvokeTestProcRecs);
   RegisterTest(TTestInvokeUntyped);
   RegisterTest(TTestInvokeInstanceMethods);
+  RegisterTest(TTestRecordMethodInvoke);
 {$else fpc}
   RegisterTest(TTestInvoke.Suite);
   RegisterTest(TTestInvokeIntfMethods.Suite);