paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 18:30:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

* TRTTIWriter improvements:

Browse Source 
* Emit typename for Variants (Delphi compatible)
  * For objects, write record-style RTTI instead of class-style. Objects cannot have published symbols, so class-style RTTI for them is always empty, thus typeinfo() was returning a useless stub. The new behavior is closer to Delphi, but still different (Delphi typeinfo() returns pointer to what is initrtti in FPC, while we return fullrtti).

git-svn-id: trunk@16612 -
This commit is contained in:
sergei 2010-12-22 14:45:40 +00:00
parent b50cf9a42a
commit cd1f8e14f4
1 changed files with 10 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
compiler/ncgrtti.pas
View File

@ -395,7 +395,7 @@ implementation
procedure variantdef_rtti(def:tvariantdef); procedure variantdef_rtti(def:tvariantdef);
begin begin
current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkVariant)); write_header(def,tkVariant);
end; end;
procedure stringdef_rtti(def:tstringdef); procedure stringdef_rtti(def:tstringdef);
@ -734,7 +734,7 @@ implementation
procedure objectdef_rtti(def:tobjectdef); procedure objectdef_rtti(def:tobjectdef);
procedure objectdef_rtti_class_init(def:tobjectdef); procedure objectdef_rtti_fields(def:tobjectdef);
begin begin
current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.size)); current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.size));
fields_write_rtti_data(def.symtable,rt); fields_write_rtti_data(def.symtable,rt);
@ -858,16 +858,20 @@ implementation
initrtti : initrtti :
begin begin
if def.objecttype in [odt_class,odt_object] then if def.objecttype in [odt_class,odt_object] then
objectdef_rtti_class_init(def) objectdef_rtti_fields(def)
else else
objectdef_rtti_interface_init(def); objectdef_rtti_interface_init(def);
end; end;
fullrtti : fullrtti :
begin begin
if def.objecttype in [odt_class,odt_object] then case def.objecttype of
objectdef_rtti_class_full(def) odt_class:
objectdef_rtti_class_full(def);
odt_object:
objectdef_rtti_fields(def);
else else
objectdef_rtti_interface_full(def); objectdef_rtti_interface_full(def);
end;
end; end;
end; end;
end; end;
@ -1152,7 +1156,7 @@ implementation
begin begin
if assigned(tobjectdef(def).childof) then if assigned(tobjectdef(def).childof) then
write_rtti(tobjectdef(def).childof,rt); write_rtti(tobjectdef(def).childof,rt);
if rt=initrtti then if (rt=initrtti) or (tobjectdef(def).objecttype=odt_object) then
fields_write_rtti(tobjectdef(def).symtable,rt) fields_write_rtti(tobjectdef(def).symtable,rt)
else else
published_write_rtti(tobjectdef(def).symtable,rt); published_write_rtti(tobjectdef(def).symtable,rt);