mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 22:09:33 +02:00
+ 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:
parent
62a61bdb41
commit
58ada1f547
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user