소스 검색

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;