mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-16 04:49:19 +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 TestProcVar;
|
||||||
procedure TestMethod;
|
procedure TestMethod;
|
||||||
|
|
||||||
|
procedure TestRawThunk;
|
||||||
private
|
private
|
||||||
procedure MakeFromOrdinalTObject;
|
procedure MakeFromOrdinalTObject;
|
||||||
procedure MakeFromOrdinalSet;
|
procedure MakeFromOrdinalSet;
|
||||||
@ -1872,6 +1874,24 @@ begin
|
|||||||
end;
|
end;
|
||||||
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}
|
{$ifdef fpc}
|
||||||
procedure TTestCase1.TestInterfaceRaw;
|
procedure TTestCase1.TestInterfaceRaw;
|
||||||
var
|
var
|
||||||
|
Loading…
Reference in New Issue
Block a user