* also check the base types of interfaces

git-svn-id: trunk@37706 -

packages/rtl-objpas/tests/tests.rtti.pas

@@ -1287,14 +1287,27 @@ procedure TTestCase1.TestInterface;
 var
   context: TRttiContext;
   t: TRttiType;
+  ti1, ti2: TRttiInterfaceType;
 begin
   context := TRttiContext.Create;
   try
     t := context.GetType(TypeInfo(IInterface));
     Check(t is TRttiInterfaceType, 'Type is not an interface type');
 
+    Check(not Assigned(t.BaseType), 'Base type is assigned');
+
+    ti1 := TRttiInterfaceType(t);
+    Check(not Assigned(ti1.BaseType), 'Base type is assigned');
+
     t := context.GetType(TypeInfo(ITestInterface));
     Check(t is TRttiInterfaceType, 'Type is not an interface type');
+
+    Check(Assigned(t.BaseType), 'Base type is not assigned');
+    Check(t.BaseType = TRttiType(ti1), 'Base type does not match');
+
+    ti2 := TRttiInterfaceType(t);
+    Check(Assigned(ti2.BaseType), 'Base type is not assigned');
+    Check(ti2.BaseType = ti1, 'Base type does not match');
   finally
     context.Free;
   end;
@@ -1305,11 +1318,17 @@ procedure TTestCase1.TestInterfaceRaw;
 var
   context: TRttiContext;
   t: TRttiType;
+  ti: TRttiInterfaceType;
 begin
   context := TRttiContext.Create;
   try
     t := context.GetType(TypeInfo(ICORBATest));
     Check(t is TRttiInterfaceType, 'Type is not a raw interface type');
+
+    Check(not Assigned(t.BaseType), 'Base type is assigned');
+
+    ti := TRttiInterfaceType(t);
+    Check(not Assigned(ti.BaseType), 'Base type is assigned');
   finally
     context.Free;
   end;