瀏覽代碼

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 年之前
父節點
當前提交
b0b051ae83
共有 4 個文件被更改,包括 26 次插入7 次删除
  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;