Jelajahi Sumber

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 tahun lalu
induk
melakukan
b0b051ae83
4 mengubah file dengan 26 tambahan dan 7 penghapusan
  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;
             propnamelist:=TFPHashObjectList.Create;
             collect_propnamelist(propnamelist,def);
             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 }
             { write parent typeinfo }
             if assigned(def.childof) then
             if assigned(def.childof) then
@@ -778,6 +779,13 @@ implementation
             else
             else
               current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil));
               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 }
             { total number of unique properties }
             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(propnamelist.count));
             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(propnamelist.count));
 
 
@@ -851,7 +859,6 @@ implementation
 
 
         begin
         begin
            case def.objecttype of
            case def.objecttype of
-             odt_helper,
              odt_class:
              odt_class:
                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkclass));
                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkclass));
              odt_object:
              odt_object:
@@ -861,6 +868,8 @@ implementation
                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkinterface));
                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkinterface));
              odt_interfacecorba:
              odt_interfacecorba:
                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkinterfaceCorba));
                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
              else
                internalerror(200611034);
                internalerror(200611034);
            end;
            end;

+ 2 - 1
compiler/symconst.pas

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

+ 1 - 0
rtl/inc/system.inc

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

+ 9 - 1
rtl/objpas/typinfo.pp

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