Browse Source

+ add a test for RawThunk; this does not require a function call manager thus it's better to place it in the general RTTI testcase so that it's always tested

git-svn-id: trunk@42733 -
svenbarth 6 years ago
parent
commit
58ada1f547
1 changed files with 20 additions and 0 deletions
  1. 20 0
      packages/rtl-objpas/tests/tests.rtti.pas

+ 20 - 0
packages/rtl-objpas/tests/tests.rtti.pas

@@ -83,6 +83,8 @@ type
 
     procedure TestProcVar;
     procedure TestMethod;
+
+    procedure TestRawThunk;
   private
     procedure MakeFromOrdinalTObject;
     procedure MakeFromOrdinalSet;
@@ -1872,6 +1874,24 @@ begin
   end;
 end;
 
+procedure TTestCase1.TestRawThunk;
+var
+  intf: IInterface;
+begin
+  { we test the raw thunking by instantiating a TVirtualInterface of IInterface }
+  { this does not require a function call manager as the thunking is implemented
+    directly inside the RTTI unit }
+  try
+    intf := TVirtualInterface.Create(PTypeInfo(TypeInfo(IInterface))) as IInterface;
+  except
+    on e: ENotImplemented do
+      Ignore('RawThunk not implemented');
+  end;
+  { if all went well QueryInterface and _AddRef were called and now we call
+    _Release as well }
+  intf := Nil;
+end;
+
 {$ifdef fpc}
 procedure TTestCase1.TestInterfaceRaw;
 var