From 4c2cdc6e03ad761e87ac473a7b89b7745bc592a0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Micha=C3=ABl=20Van=20Canneyt?= <michael@freepascal.org>
Date: Tue, 21 Dec 2021 17:45:33 +0100
Subject: [PATCH] * Enhanced patch from Henrique Werlang to implement ancestor
 type. Fix issue #38945

---
 packages/rtl/rtti.pas | 43 +++++++++++++++++++++++++++++++++++++------
 1 file changed, 37 insertions(+), 6 deletions(-)

diff --git a/packages/rtl/rtti.pas b/packages/rtl/rtti.pas
index c0e4c7f..edd5b85 100644
--- a/packages/rtl/rtti.pas
+++ b/packages/rtl/rtti.pas
@@ -264,7 +264,7 @@ type
     function GetIsSet: Boolean; virtual;
     function GetTypeKind: TTypeKind; virtual;
     //function GetTypeSize: integer; virtual;
-    //function GetBaseType: TRttiType; virtual;
+    function GetBaseType: TRttiType; virtual;
     function LoadCustomAttributes: TCustomAttributeArray; override;
   public
     constructor Create(ATypeInfo : PTypeInfo);
@@ -288,7 +288,7 @@ type
     property IsOrdinal: Boolean read GetIsOrdinal;
     property IsRecord: Boolean read GetIsRecord;
     property IsSet: Boolean read GetIsSet;
-    //property BaseType: TRttiType read GetBaseType;
+    property BaseType: TRttiType read GetBaseType;
     property AsInstance: TRttiInstanceType read GetAsInstance;
     property AsInstanceExternal: TRttiInstanceExternalType read GetAsInstanceExternal;
     property TypeKind: TTypeKind read GetTypeKind;
@@ -330,13 +330,16 @@ type
 
   TRttiInstanceType = class(TRttiStructuredType)
   private
+    function GetAncestorType: TRttiInstanceType;
     function GetClassTypeInfo: TTypeInfoClass;
     function GetMetaClassType: TClass;
   protected
     function GetAncestor: TRttiStructuredType; override;
+    function GetBaseType : TRttiType; override;
   public
     constructor Create(ATypeInfo: PTypeInfo);
-
+    property BaseType : TRttiInstanceType read GetAncestorType;
+    property Ancestor: TRttiInstanceType read GetAncestorType;
     property ClassTypeInfo: TTypeInfoClass read GetClassTypeInfo;
     property MetaClassType: TClass read GetMetaClassType;
   end;
@@ -345,13 +348,16 @@ type
 
   TRttiInterfaceType = class(TRttiStructuredType)
   private
+    function GetAncestorType: TRttiInterfaceType;
     function GetGUID: TGUID;
     function GetInterfaceTypeInfo: TTypeInfoInterface;
   protected
     function GetAncestor: TRttiStructuredType; override;
+    function GetBaseType : TRttiType; override;
   public
     constructor Create(ATypeInfo: PTypeInfo);
-
+    property BaseType : TRttiInterfaceType read GetAncestorType;
+    property Ancestor: TRttiInterfaceType read GetAncestorType;
     property GUID: TGUID read GetGUID;
     property InterfaceTypeInfo: TTypeInfoInterface read GetInterfaceTypeInfo;
   end;
@@ -1208,7 +1214,17 @@ end;
 
 function TRttiInstanceType.GetAncestor: TRttiStructuredType;
 begin
-  Result := GRttiContext.GetType(ClassTypeInfo.Ancestor) as TRttiStructuredType;
+  Result := GetAncestorType;
+end;
+
+function TRttiInstanceType.GetBaseType: TRttiType;
+begin
+  Result:=GetAncestorType;
+end;
+
+function TRttiInstanceType.GetAncestorType: TRttiInstanceType;
+begin
+  Result := GRttiContext.GetType(ClassTypeInfo.Ancestor) as TRttiInstanceType;
 end;
 
 constructor TRttiInstanceType.Create(ATypeInfo: PTypeInfo);
@@ -1244,7 +1260,17 @@ end;
 
 function TRttiInterfaceType.GetAncestor: TRttiStructuredType;
 begin
-  Result := GRttiContext.GetType(InterfaceTypeInfo.Ancestor) as TRttiStructuredType;
+  Result := GetAncestorType;
+end;
+
+function TRttiInterfaceType.GetBaseType: TRttiType;
+begin
+  Result:=GetAncestorType;
+end;
+
+function TRttiInterfaceType.GetAncestorType: TRttiInterfaceType;
+begin
+  Result := GRttiContext.GetType(InterfaceTypeInfo.Ancestor) as TRttiInterfaceType;
 end;
 
 { TRttiRecordType }
@@ -1736,6 +1762,11 @@ begin
   Result:=FTypeInfo.Kind;
 end;
 
+function TRttiType.GetBaseType: TRttiType;
+begin
+  Result:=Nil;
+end;
+
 function TRttiType.GetAsInstance: TRttiInstanceType;
 begin
   Result := Self as TRttiInstanceType;