Browse Source

Introduce a new type kind for helpers in the RTTI. This is Delphi incompatible, but it's cleaner than Delphi's "let's extend some magic class". This might not matter much though, because according to Google the RTTI for class helpers seems to be rarely used.

* compiler/ncgrtti.pas:
- objectdef_rtti_class_full:
 - don't write the VMT data for helpers
 - write the typeinfo of the extended type (something that Delphi does definitely not support :P )
- objectdef_rtti: write the new type kind for helpers instead that of classes
* compiler/symconst.pas: introduce new type kind constant "tkHelper" before "tkFile" (what is that used for btw?)
* rtl/inc/system.inc: add the constant here as well (why wasn't tkUChar added here?)
* objpas/typinfo.pp: 
- add tkHelper to the TTypeKind enum (but here tkUChar was added?!)
- extend the TTypeData record with the data of helpers

git-svn-id: branches/svenbarth/classhelpers@17240 -
svenbarth 14 years ago
parent
commit
b0b051ae83
4 changed files with 26 additions and 7 deletions
  1. 14 5
      compiler/ncgrtti.pas
  2. 2 1
      compiler/symconst.pas
  3. 1 0
      rtl/inc/system.inc
  4. 9 1
      rtl/objpas/typinfo.pp

+ 14 - 5
compiler/ncgrtti.pas

@@ -767,10 +767,11 @@ implementation
             propnamelist:=TFPHashObjectList.Create;
             collect_propnamelist(propnamelist,def);
 
-            if (oo_has_vmt in def.objectoptions) then
-              current_asmdata.asmlists[al_rtti].concat(Tai_const.Createname(def.vmt_mangledname,0))
-            else
-              current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil));
+            if not is_objectpascal_helper(def) then
+              if (oo_has_vmt in def.objectoptions) then
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Createname(def.vmt_mangledname,0))
+              else
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil));
 
             { write parent typeinfo }
             if assigned(def.childof) then
@@ -778,6 +779,13 @@ implementation
             else
               current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil));
 
+            { write typeinfo of extended type }
+            if is_objectpascal_helper(def) then
+              if assigned(def.extendeddef) then
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.extendeddef,fullrtti)))
+              else
+                InternalError(2011033001);
+
             { total number of unique properties }
             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(propnamelist.count));
 
@@ -851,7 +859,6 @@ implementation
 
         begin
            case def.objecttype of
-             odt_helper,
              odt_class:
                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkclass));
              odt_object:
@@ -861,6 +868,8 @@ implementation
                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkinterface));
              odt_interfacecorba:
                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkinterfaceCorba));
+             odt_helper:
+               current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkhelper));
              else
                internalerror(200611034);
            end;

+ 2 - 1
compiler/symconst.pas

@@ -64,7 +64,8 @@ const
   tkProcVar  = 23;
   tkUString  = 24;
   tkUChar    = 25;
-  tkFile     = 26;
+  tkHelper   = 26;
+  tkFile     = 27;
 
   otSByte     = 0;
   otUByte     = 1;

+ 1 - 0
rtl/inc/system.inc

@@ -44,6 +44,7 @@ Const
    tkInterfaceCorba = 22;
    tkProcVar       = 23;
    tkUString       = 24;
+   tkHelper        = 26;
 
   // all potentially managed types
   tkManagedTypes   = [tkAstring,tkWstring,tkUstring,tkArray,

+ 9 - 1
rtl/objpas/typinfo.pp

@@ -42,7 +42,8 @@ unit typinfo;
                    tkSet,tkMethod,tkSString,tkLString,tkAString,
                    tkWString,tkVariant,tkArray,tkRecord,tkInterface,
                    tkClass,tkObject,tkWChar,tkBool,tkInt64,tkQWord,
-                   tkDynArray,tkInterfaceRaw,tkProcVar,tkUString,tkUChar);
+                   tkDynArray,tkInterfaceRaw,tkProcVar,tkUString,tkUChar,
+                   tkHelper);
 
        TOrdType  = (otSByte,otUByte,otSWord,otUWord,otSLong,otULong);
 
@@ -151,6 +152,13 @@ unit typinfo;
                UnitName : ShortString
                // here the properties follow as array of TPropInfo
               );
+            tkHelper:
+              (HelperParent : PTypeInfo;
+               ExtendedInfo : PTypeInfo;
+               HelperProps : SmallInt;
+               HelperUnit : ShortString
+               // here the properties follow as array of TPropInfo
+              );
             tkMethod:
               (MethodKind : TMethodKind;
                ParamCount : Byte;