Browse Source

* also test IIDStr of raw interfaces

git-svn-id: trunk@35414 -
svenbarth 8 years ago
parent
commit
58abeb4a34
1 changed files with 6 additions and 3 deletions
  1. 6 3
      tests/test/trtti15.pp

+ 6 - 3
tests/test/trtti15.pp

@@ -30,6 +30,7 @@ type
 
 
   {$interfaces corba}
   {$interfaces corba}
   ITestRaw = interface
   ITestRaw = interface
+    ['Test']
     function Test: LongInt;
     function Test: LongInt;
     property T: LongInt read Test;
     property T: LongInt read Test;
   end;
   end;
@@ -133,7 +134,7 @@ begin
     Result.params[i - Low(aParams)] := aParams[i];
     Result.params[i - Low(aParams)] := aParams[i];
 end;
 end;
 
 
-procedure TestInterface(aIntf: PTypeData; aRaw: Boolean; aPropCount: LongInt; aMethods: array of TTestMethod);
+procedure TestInterface(aIntf: PTypeData; aRaw: Boolean; aIIDStr: String; aPropCount: LongInt; aMethods: array of TTestMethod);
 var
 var
   proptable: PPropData;
   proptable: PPropData;
   methtable: PIntfMethodTable;
   methtable: PIntfMethodTable;
@@ -142,6 +143,8 @@ 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;
+    if PInterfaceRawData(aIntf)^.IIDStr <> aIIDStr then
+      ErrorHalt('Expected IIDStr ''%s'', but got ''%s''', [aIIDStr, PInterfaceRawData(aIntf)^.IIDStr]);
   end else begin
   end else begin
     proptable := PInterfaceData(aIntf)^.PropertyTable;
     proptable := PInterfaceData(aIntf)^.PropertyTable;
     methtable := PInterfaceData(aIntf)^.MethodTable;
     methtable := PInterfaceData(aIntf)^.MethodTable;
@@ -171,12 +174,12 @@ const
 begin
 begin
   Writeln('Testing interface ITestRaw');
   Writeln('Testing interface ITestRaw');
   { raw interfaces don't support $M+ currently }
   { raw interfaces don't support $M+ currently }
-  TestInterface(GetTypeData(TypeInfo(ITestRaw)), True, 0{1}, [
+  TestInterface(GetTypeData(TypeInfo(ITestRaw)), True, 'Test', 0{1}, [
       MakeMethod('Test', ccReg, mkFunction, TypeInfo(LongInt), [])
       MakeMethod('Test', ccReg, mkFunction, TypeInfo(LongInt), [])
     ]);
     ]);
 
 
   Writeln('Testing interface ITest');
   Writeln('Testing interface ITest');
-  TestInterface(GetTypeData(TypeInfo(ITest)), False, 2, [
+  TestInterface(GetTypeData(TypeInfo(ITest)), False, '', 2, [
       MakeMethod('Test', DefaultCallingConvention, mkProcedure, Nil, [
       MakeMethod('Test', DefaultCallingConvention, mkProcedure, Nil, [
           MakeParam('$self', [pfHidden, pfSelf, pfAddress], TypeInfo(ITest))
           MakeParam('$self', [pfHidden, pfSelf, pfAddress], TypeInfo(ITest))
         ]),
         ]),