From c15bcc693db1228bfbedd4eb612f1ee1d6b126ce Mon Sep 17 00:00:00 2001
From: svenbarth <pascaldragon@googlemail.com>
Date: Fri, 8 Dec 2017 23:01:25 +0000
Subject: [PATCH] * also check the base types of interfaces

git-svn-id: trunk@37706 -
---
 packages/rtl-objpas/tests/tests.rtti.pas | 19 +++++++++++++++++++
 1 file changed, 19 insertions(+)

diff --git a/packages/rtl-objpas/tests/tests.rtti.pas b/packages/rtl-objpas/tests/tests.rtti.pas
index c2e12d3d85..2f6174eedd 100644
--- a/packages/rtl-objpas/tests/tests.rtti.pas
+++ b/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;