paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-03 04:10:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed interface rtti, fixes bug #4089

Browse Source 
git-svn-id: trunk@423 -
This commit is contained in:
florian 2005-06-15 21:28:15 +00:00
parent 90cdc1b6fe
commit be9bd97532
2 changed files with 72 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
compiler/symconst.pas
View File

@ -112,7 +112,11 @@ const
paranr_syscall_legacy = high(word)-2;
paranr_result_leftright = high(word)-1;
type
{ keep this in sync with TIntfFlag in rtl/objpas/typinfo.pp }
TCompilerIntfFlag = (ifHasGuid,ifDispInterface,ifDispatch,ifHasStrGUID);
{ Deref entry options }
tdereftype = (deref_nil,
deref_sym,

88
compiler/symdef.pas
View File

@ -5889,6 +5889,8 @@ implementation
procedure tobjectdef.write_rtti_data(rt:trttitype);
var
i : longint;
begin
case objecttype of
odt_class:
@ -5924,27 +5926,55 @@ implementation
end;
fullrtti :
begin
if (oo_has_vmt in objectoptions) and
not(objecttype in [odt_interfacecom,odt_interfacecorba]) then
rttiList.concat(Tai_const.Createname(vmt_mangledname,AT_DATA,0))
else
rttiList.concat(Tai_const.create_sym(nil));
if not(objecttype in [odt_interfacecom,odt_interfacecorba]) then
begin
if (oo_has_vmt in objectoptions) then
rttiList.concat(Tai_const.Createname(vmt_mangledname,AT_DATA,0))
else
rttiList.concat(Tai_const.create_sym(nil));
end;
{ write owner typeinfo }
if assigned(childof) and (oo_can_have_published in childof.objectoptions) then
{ write parent typeinfo }
if assigned(childof) and ((oo_can_have_published in childof.objectoptions) or
(objecttype in [odt_interfacecom,odt_interfacecorba])) then
rttiList.concat(Tai_const.Create_sym(childof.get_rtti_label(fullrtti)))
else
rttiList.concat(Tai_const.create_sym(nil));
{ count total number of properties }
if assigned(childof) and (oo_can_have_published in childof.objectoptions) then
count:=childof.next_free_name_index
else
count:=0;
if objecttype in [odt_object,odt_class] then
begin
{ count total number of properties }
if assigned(childof) and (oo_can_have_published in childof.objectoptions) then
count:=childof.next_free_name_index
else
count:=0;
{ write it }
symtable.foreach(@count_published_properties,nil);
rttiList.concat(Tai_const.Create_16bit(count));
{ write it }
symtable.foreach(@count_published_properties,nil);
rttiList.concat(Tai_const.Create_16bit(count));
end
else
{ interface: write flags, iid and iidstr }
begin
rttiList.concat(Tai_const.Create_32bit(
{ ugly, but working }
longint([
TCompilerIntfFlag(ord(ifHasGuid)*ord(assigned(iidguid))),
TCompilerIntfFlag(ord(ifHasStrGUID)*ord(assigned(iidstr)))
])
{
ifDispInterface,
ifDispatch, }
));
{$ifdef cpurequiresproperalignment}
rttilist.concat(Tai_align.Create(sizeof(TConstPtrUInt)));
{$endif cpurequiresproperalignment}
rttilist.concat(Tai_const.Create_32bit(longint(iidguid^.D1)));
rttilist.concat(Tai_const.Create_16bit(iidguid^.D2));
rttilist.concat(Tai_const.Create_16bit(iidguid^.D3));
for i:=Low(iidguid^.D4) to High(iidguid^.D4) do
rttilist.concat(Tai_const.Create_8bit(iidguid^.D4[i]));
end;
{ write unit name }
rttiList.concat(Tai_const.Create_8bit(length(current_module.realmodulename^)));
@ -5954,14 +5984,32 @@ implementation
rttilist.concat(Tai_align.Create(sizeof(TConstPtrUInt)));
{$endif cpurequiresproperalignment}
{ write published properties count }
count:=0;
symtable.foreach(@count_published_properties,nil);
rttiList.concat(Tai_const.Create_16bit(count));
{ write iidstr }
if objecttype in [odt_interfacecom,odt_interfacecorba] then
begin
if assigned(iidstr) then
begin
rttiList.concat(Tai_const.Create_8bit(length(iidstr^)));
rttiList.concat(Tai_string.Create(iidstr^));
end
else
rttiList.concat(Tai_const.Create_8bit(0));
{$ifdef cpurequiresproperalignment}
rttilist.concat(Tai_align.Create(sizeof(TConstPtrUInt)));
{$endif cpurequiresproperalignment}
end;
if objecttype in [odt_object,odt_class] then
begin
{ write published properties count }
count:=0;
symtable.foreach(@count_published_properties,nil);
rttiList.concat(Tai_const.Create_16bit(count));
{$ifdef cpurequiresproperalignment}
rttilist.concat(Tai_align.Create(sizeof(TConstPtrUInt)));
rttilist.concat(Tai_align.Create(sizeof(TConstPtrUInt)));
{$endif cpurequiresproperalignment}
end;
{ count is used to write nameindex }