diff --git a/compiler/utils/ppudump.pp b/compiler/utils/ppudump.pp index 36e6f8adad..84ee011d46 100644 --- a/compiler/utils/ppudump.pp +++ b/compiler/utils/ppudump.pp @@ -846,10 +846,37 @@ type ); 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 { needed during tobjectdef parsing... } current_defoptions : tdefoptions; + current_objectoptions : tobjectoptions; procedure readcommondef(const s:string; out defoptions: tdefoptions); type @@ -1401,32 +1428,6 @@ end; procedure readobjectdefoptions; 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 mask : tobjectoption; str : string[30]; @@ -1458,16 +1459,15 @@ const (mask:oo_has_class_destructor; str:'HasClassDestructor') ); var - symoptions : tobjectoptions; i : longint; first : boolean; begin - ppufile.getsmallset(symoptions); - if symoptions<>[] then + ppufile.getsmallset(current_objectoptions); + if current_objectoptions<>[] then begin first:=true; for i:=1 to high(symopt) do - if (symopt[i].mask in symoptions) then + if (symopt[i].mask in current_objectoptions) then begin if first then first:=false @@ -1901,7 +1901,8 @@ type odt_cppclass, odt_dispinterface, odt_objcclass, - odt_objcprotocol + odt_objcprotocol, + odt_classhelper ); tvarianttype = ( vt_normalvariant,vt_olevariant @@ -2131,6 +2132,7 @@ begin odt_dispinterface : writeln('dispinterface'); odt_objcclass : writeln('objcclass'); odt_objcprotocol : writeln('objcprotocol'); + odt_classhelper : writeln('class helper'); else writeln('!! Warning: Invalid object type ',b); end; writeln(space,' External name : ',getstring); @@ -2150,6 +2152,13 @@ begin writeln(space,' IID String : ',getstring); end; + if (tobjecttyp(b)=odt_classhelper) or + (oo_is_classhelper in current_objectoptions) then + begin + write(space,' Helper parent : '); + readderef(''); + end; + l:=getlongint; writeln(space,' VMT entries: ',l); for j:=1 to l do