paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 17:49:25 +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; property T2: LongInt read Test2;
end; end;
(*{$interfaces corba} {$interfaces corba}
ITestRaw = interface ITestRaw = interface
function Test: LongInt; function Test: LongInt;
property T: LongInt read Test; property T: LongInt read Test;
end;*) end;
{$pop} {$pop}
procedure ErrorHalt(const aMsg: String; const aArgs: array of const); procedure ErrorHalt(const aMsg: String; const aArgs: array of const);
@ -139,10 +139,10 @@ var
methtable: PIntfMethodTable; methtable: PIntfMethodTable;
i: LongInt; i: LongInt;
begin begin
{if aRaw then begin if aRaw then begin
proptable := PInterfaceRawData(aIntf)^.PropertyTable; proptable := PInterfaceRawData(aIntf)^.PropertyTable;
methtable := PInterfaceRawData(aIntf)^.MethodTable; methtable := PInterfaceRawData(aIntf)^.MethodTable;
end else }begin end else begin
proptable := PInterfaceData(aIntf)^.PropertyTable; proptable := PInterfaceData(aIntf)^.PropertyTable;
methtable := PInterfaceData(aIntf)^.MethodTable; methtable := PInterfaceData(aIntf)^.MethodTable;
end; end;
@ -169,9 +169,10 @@ const
{$endif} {$endif}
begin 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), []) MakeMethod('Test', ccReg, mkFunction, TypeInfo(LongInt), [])
]);} ]);
TestInterface(GetTypeData(TypeInfo(ITest)), False, 2, [ TestInterface(GetTypeData(TypeInfo(ITest)), False, 2, [
MakeMethod('Test', DefaultCallingConvention, mkProcedure, Nil, [ MakeMethod('Test', DefaultCallingConvention, mkProcedure, Nil, [