Browse Source

Switch class and interface parent as well as extended type to indirect type information

compiler/ncgrtti.pas, TRTTIWriter:
  * write_rtti_data.objectdef_rtti.objectdef_rtti_class_full: use indirect reference for class parent and extended type
  * write_rtti_data.objectdef_rtti.objectdef_rtti_interface_full: use indirect reference for interface parent

rtl/objpas/typinfo.pp, TTypeData:
  + add new method DerefTypeInfoPtr which returns Nil if the indirect reference is Nil and otherwise returns the dereferences indirect reference (for 2.6.x the direct reference is returned as is)
  * rename ParentInfo to ParentInfoRef, HelperParent to HelperParentRef, ExtendedInfo to ExtendedInfoRef, IntfParent ot IntfParentRef and RawIntfParent to RawIntfParentRef and change their type to TypeInfoPtr
  + introduce ParentInfo, HelperParent, ExtendedInfo, IntfParent and RawIntfParent properties that return a PTypeInfo and use the new DerefTypeInfoPtr to return the correct type info value
  * change the other newly introduced properties of TTypeData to use DerefTypeInfoPtr as well to be on the safe side

git-svn-id: branches/svenbarth/packages@28289 -
svenbarth 11 years ago
parent
commit
c785526457
2 changed files with 64 additions and 12 deletions
  1. 3 3
      compiler/ncgrtti.pas
  2. 61 9
      rtl/objpas/typinfo.pp

+ 3 - 3
compiler/ncgrtti.pas

@@ -879,12 +879,12 @@ implementation
                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_nil_dataptr);
 
             { write parent typeinfo }
-            write_rtti_reference(def.childof,fullrtti);
+            write_rtti_reference(def.childof,fullrtti,true);
 
             { write typeinfo of extended type }
             if is_objectpascal_helper(def) then
               if assigned(def.extendeddef) then
-                write_rtti_reference(def.extendeddef,fullrtti)
+                write_rtti_reference(def.extendeddef,fullrtti,true)
               else
                 InternalError(2011033001);
 
@@ -917,7 +917,7 @@ implementation
             collect_propnamelist(propnamelist,def);
 
             { write parent typeinfo }
-            write_rtti_reference(def.childof,fullrtti);
+            write_rtti_reference(def.childof,fullrtti,true);
 
             { interface: write flags, iid and iidstr }
             IntfFlags:=0;

+ 61 - 9
rtl/objpas/typinfo.pp

@@ -175,8 +175,14 @@ unit typinfo;
 {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
       record
       private
+        function DerefTypeInfoPtr(Info: TypeInfoPtr): PTypeInfo; inline;
         function GetBaseType: PTypeInfo; inline;
         function GetCompType: PTypeInfo; inline;
+        function GetParentInfo: PTypeInfo; inline;
+        function GetHelperParent: PTypeInfo; inline;
+        function GetExtendedInfo: PTypeInfo; inline;
+        function GetIntfParent: PTypeInfo; inline;
+        function GetRawIntfParent: PTypeInfo; inline;
         function GetInstanceType: PTypeInfo; inline;
         function GetRefType: PTypeInfo; inline;
       public
@@ -184,6 +190,15 @@ unit typinfo;
         property BaseType: PTypeInfo read GetBaseType;
         { tkSet }
         property CompType: PTypeInfo read GetCompType;
+        { tkClass }
+        property ParentInfo: PTypeInfo read GetParentInfo;
+        { tkHelper }
+        property HelperParent: PTypeInfo read GetHelperParent;
+        property ExtendedInfo: PTypeInfo read GetExtendedInfo;
+        { tkInterface }
+        property IntfParent: PTypeInfo read GetIntfParent;
+        { tkInterfaceRaw }
+        property RawIntfParent: PTypeInfo read GetRawIntfParent;
         { tkClassRef }
         property InstanceType: PTypeInfo read GetInstanceType;
         { tkPointer }
@@ -217,7 +232,7 @@ unit typinfo;
               (MaxLength : Byte);
             tkClass:
               (ClassType : TClass;
-               ParentInfo : PTypeInfo;
+               ParentInfoRef : TypeInfoPtr;
                PropCount : SmallInt;
                UnitName : ShortString
                // here the properties follow as array of TPropInfo
@@ -229,8 +244,8 @@ unit typinfo;
                 {ManagedFields: array[1..ManagedFldCount] of TManagedField}
               );
             tkHelper:
-              (HelperParent : PTypeInfo;
-               ExtendedInfo : PTypeInfo;
+              (HelperParentRef : TypeInfoPtr;
+               ExtendedInfoRef : TypeInfoPtr;
                HelperProps : SmallInt;
                HelperUnit : ShortString
                // here the properties follow as array of TPropInfo
@@ -259,14 +274,14 @@ unit typinfo;
               (MinQWordValue, MaxQWordValue: QWord);
             tkInterface:
               (
-               IntfParent: PTypeInfo;
+               IntfParentRef: TypeInfoPtr;
                IntfFlags : TIntfFlagsBase;
                GUID: TGUID;
                IntfUnit: ShortString;
               );
             tkInterfaceRaw:
               (
-               RawIntfParent: PTypeInfo;
+               RawIntfParentRef: TypeInfoPtr;
                RawIntfFlags : TIntfFlagsBase;
                IID: TGUID;
                RawIntfUnit: ShortString;
@@ -2089,24 +2104,61 @@ end;
 
 { TTypeData }
 
+function TTypeData.DerefTypeInfoPtr(Info: TypeInfoPtr): PTypeInfo; inline;
+begin
+{$ifdef ver2_6}
+  Result := Info;
+{$else}
+  if not Assigned(Info) then
+    Result := Nil
+  else
+    Result := Info^;
+{$endif}
+end;
+
 function TTypeData.GetBaseType: PTypeInfo;
 begin
-  Result := BaseTypeRef{$ifndef ver2_6}^{$endif};
+  Result := DerefTypeInfoPtr(BaseTypeRef);
 end;
 
 function TTypeData.GetCompType: PTypeInfo;
 begin
-  Result := CompTypeRef{$ifndef ver2_6}^{$endif};
+  Result := DerefTypeInfoPtr(CompTypeRef);
+end;
+
+function TTypeData.GetParentInfo: PTypeInfo; inline;
+begin
+  Result := DerefTypeInfoPtr(ParentInfoRef);
+end;
+
+function TTypeData.GetHelperParent: PTypeInfo; inline;
+begin
+  Result := DerefTypeInfoPtr(HelperParentRef);
+end;
+
+function TTypeData.GetExtendedInfo: PTypeInfo; inline;
+begin
+  Result := DerefTypeInfoPtr(ExtendedInfoRef);
+end;
+
+function TTypeData.GetIntfParent: PTypeInfo; inline;
+begin
+  Result := DerefTypeInfoPtr(IntfParentRef);
+end;
+
+function TTypeData.GetRawIntfParent: PTypeInfo; inline;
+begin
+  Result := DerefTypeInfoPtr(RawIntfParentRef);
 end;
 
 function TTypeData.GetInstanceType: PTypeInfo;
 begin
-  Result := InstanceTypeRef{$ifndef ver2_6}^{$endif};
+  Result := DerefTypeInfoPtr(InstanceTypeRef);
 end;
 
 function TTypeData.GetRefType: PTypeInfo;
 begin
-  Result := RefTypeRef{$ifndef ver2_6}^{$endif}
+  Result := DerefTypeInfoPtr(RefTypeRef);
 end;
 
 { TPropInfo }