mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-14 19:09:16 +02:00
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 -
This commit is contained in:
parent
3b4eae7d23
commit
36ee46110c
@ -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);
|
ppufile.getsmallset(current_objectoptions);
|
||||||
if symoptions<>[] then
|
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
|
||||||
|
Loading…
Reference in New Issue
Block a user