+ 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 -
This commit is contained in:
svenbarth 2019-08-18 18:30:39 +00:00
parent 62a61bdb41
commit 58ada1f547

View File

@ -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