paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 01:29:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

* enable raw interface testing

Browse Source 
git-svn-id: trunk@35412 -
This commit is contained in:
svenbarth 2017-02-10 16:05:35 +00:00
parent 870bffc70d
commit 6418f22ae0
1 changed files with 7 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
tests/test/trtti15.pp
View File

@ -28,11 +28,11 @@ type
property T2: LongInt read Test2;
end;
(*{$interfaces corba}
{$interfaces corba}
ITestRaw = interface
function Test: LongInt;
property T: LongInt read Test;
end;*)
end;
{$pop}
procedure ErrorHalt(const aMsg: String; const aArgs: array of const);
@ -139,10 +139,10 @@ var
methtable: PIntfMethodTable;
i: LongInt;
begin
{if aRaw then begin
if aRaw then begin
proptable := PInterfaceRawData(aIntf)^.PropertyTable;
methtable := PInterfaceRawData(aIntf)^.MethodTable;
end else }begin
end else begin
proptable := PInterfaceData(aIntf)^.PropertyTable;
methtable := PInterfaceData(aIntf)^.MethodTable;
end;
@ -169,9 +169,10 @@ const
{$endif}
begin
{TestInterface(GetTypeData(TypeInfo(ITestRaw)), True, 1, [
{ raw interfaces don't support $M+ currently }
TestInterface(GetTypeData(TypeInfo(ITestRaw)), True, 0{1}, [
MakeMethod('Test', ccReg, mkFunction, TypeInfo(LongInt), [])
]);}
]);
TestInterface(GetTypeData(TypeInfo(ITest)), False, 2, [
MakeMethod('Test', DefaultCallingConvention, mkProcedure, Nil, [