Browse Source

Updated ppudump to support the new ppu data that might contain class helpers.
This needed a small restructuring of the code as we need to know the object_options (especially oo_is_classhelper) when we reach the point in the ppu where the parent class helper is stored.

git-svn-id: branches/svenbarth/classhelpers@16828 -

svenbarth 14 years ago
parent
commit
36ee46110c
1 changed files with 40 additions and 31 deletions
  1. 40 31
      compiler/utils/ppudump.pp

+ 40 - 31
compiler/utils/ppudump.pp

@@ -846,10 +846,37 @@ type
   );
   );
   tdefoptions=set of tdefoption;
   tdefoptions=set of tdefoption;
 
 
+  tobjectoption=(oo_none,
+    oo_is_forward,         { the class is only a forward declared yet }
+    oo_is_abstract,        { the class is abstract - only descendants can be used }
+    oo_is_sealed,          { the class is sealed - can't have descendants }
+    oo_has_virtual,        { the object/class has virtual methods }
+    oo_has_private,
+    oo_has_protected,
+    oo_has_strictprivate,
+    oo_has_strictprotected,
+    oo_has_constructor,    { the object/class has a constructor }
+    oo_has_destructor,     { the object/class has a destructor }
+    oo_has_vmt,            { the object/class has a vmt }
+    oo_has_msgstr,
+    oo_has_msgint,
+    oo_can_have_published,{ the class has rtti, i.e. you can publish properties }
+    oo_has_default_property,
+    oo_has_valid_guid,
+    oo_has_enumerator_movenext,
+    oo_has_enumerator_current,
+    oo_is_external,       { the class is externally implemented (objcclass, cppclass) }
+    oo_is_anonymous,      { the class is only formally defined in this module (objcclass x = class; external;) }
+    oo_is_classhelper,    { objcclasses that represent categories, and Delpi-style class helpers, are marked like this }
+    oo_has_class_constructor, { the object/class has a class constructor }
+    oo_has_class_destructor   { the object/class has a class destructor  }
+  );
+  tobjectoptions=set of tobjectoption;
 
 
 var
 var
   { needed during tobjectdef parsing... }
   { needed during tobjectdef parsing... }
   current_defoptions : tdefoptions;
   current_defoptions : tdefoptions;
+  current_objectoptions : tobjectoptions;
 
 
 procedure readcommondef(const s:string; out defoptions: tdefoptions);
 procedure readcommondef(const s:string; out defoptions: tdefoptions);
 type
 type
@@ -1401,32 +1428,6 @@ end;
 
 
 procedure readobjectdefoptions;
 procedure readobjectdefoptions;
 type
 type
-  tobjectoption=(oo_none,
-    oo_is_forward,         { the class is only a forward declared yet }
-    oo_is_abstract,        { the class is abstract - only descendants can be used }
-    oo_is_sealed,          { the class is sealed - can't have descendants }
-    oo_has_virtual,        { the object/class has virtual methods }
-    oo_has_private,
-    oo_has_protected,
-    oo_has_strictprivate,
-    oo_has_strictprotected,
-    oo_has_constructor,    { the object/class has a constructor }
-    oo_has_destructor,     { the object/class has a destructor }
-    oo_has_vmt,            { the object/class has a vmt }
-    oo_has_msgstr,
-    oo_has_msgint,
-    oo_can_have_published,{ the class has rtti, i.e. you can publish properties }
-    oo_has_default_property,
-    oo_has_valid_guid,
-    oo_has_enumerator_movenext,
-    oo_has_enumerator_current,
-    oo_is_external,       { the class is externally implemented (objcclass, cppclass) }
-    oo_is_anonymous,      { the class is only formally defined in this module (objcclass x = class; external;) }
-    oo_is_classhelper,    { objcclasses that represent categories, and Delpi-style class helpers, are marked like this }
-    oo_has_class_constructor, { the object/class has a class constructor }
-    oo_has_class_destructor   { the object/class has a class destructor  }
-  );
-  tobjectoptions=set of tobjectoption;
   tsymopt=record
   tsymopt=record
     mask : tobjectoption;
     mask : tobjectoption;
     str  : string[30];
     str  : string[30];
@@ -1458,16 +1459,15 @@ const
      (mask:oo_has_class_destructor; str:'HasClassDestructor')
      (mask:oo_has_class_destructor; str:'HasClassDestructor')
   );
   );
 var
 var
-  symoptions : tobjectoptions;
   i      : longint;
   i      : longint;
   first  : boolean;
   first  : boolean;
 begin
 begin
-  ppufile.getsmallset(symoptions);
-  if symoptions<>[] then
+  ppufile.getsmallset(current_objectoptions);
+  if current_objectoptions<>[] then
    begin
    begin
      first:=true;
      first:=true;
      for i:=1 to high(symopt) do
      for i:=1 to high(symopt) do
-      if (symopt[i].mask in symoptions) then
+      if (symopt[i].mask in current_objectoptions) then
        begin
        begin
          if first then
          if first then
            first:=false
            first:=false
@@ -1901,7 +1901,8 @@ type
     odt_cppclass,
     odt_cppclass,
     odt_dispinterface,
     odt_dispinterface,
     odt_objcclass,
     odt_objcclass,
-    odt_objcprotocol
+    odt_objcprotocol,
+    odt_classhelper
   );
   );
   tvarianttype = (
   tvarianttype = (
     vt_normalvariant,vt_olevariant
     vt_normalvariant,vt_olevariant
@@ -2131,6 +2132,7 @@ begin
                odt_dispinterface  : writeln('dispinterface');
                odt_dispinterface  : writeln('dispinterface');
                odt_objcclass      : writeln('objcclass');
                odt_objcclass      : writeln('objcclass');
                odt_objcprotocol   : writeln('objcprotocol');
                odt_objcprotocol   : writeln('objcprotocol');
+               odt_classhelper    : writeln('class helper');
                else                 writeln('!! Warning: Invalid object type ',b);
                else                 writeln('!! Warning: Invalid object type ',b);
              end;
              end;
              writeln(space,'    External name : ',getstring);
              writeln(space,'    External name : ',getstring);
@@ -2150,6 +2152,13 @@ begin
                   writeln(space,'       IID String : ',getstring);
                   writeln(space,'       IID String : ',getstring);
                end;
                end;
 
 
+             if (tobjecttyp(b)=odt_classhelper) or
+                 (oo_is_classhelper in current_objectoptions) then
+               begin
+                 write(space,'    Helper parent : ');
+                 readderef('');
+               end;
+
              l:=getlongint;
              l:=getlongint;
              writeln(space,'  VMT entries: ',l);
              writeln(space,'  VMT entries: ',l);
              for j:=1 to l do
              for j:=1 to l do