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