paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-11 07:05:59 +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);
begin
current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkVariant));
write_header(def,tkVariant);
end;
procedure stringdef_rtti(def:tstringdef);
@ -734,7 +734,7 @@ implementation
procedure objectdef_rtti(def:tobjectdef);
procedure objectdef_rtti_class_init(def:tobjectdef);
procedure objectdef_rtti_fields(def:tobjectdef);
begin
current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.size));
fields_write_rtti_data(def.symtable,rt);
@ -858,16 +858,20 @@ implementation
initrtti :
begin
if def.objecttype in [odt_class,odt_object] then
objectdef_rtti_class_init(def)
objectdef_rtti_fields(def)
else
objectdef_rtti_interface_init(def);
end;
fullrtti :
begin
if def.objecttype in [odt_class,odt_object] then
objectdef_rtti_class_full(def)
case def.objecttype of
odt_class:
objectdef_rtti_class_full(def);
odt_object:
objectdef_rtti_fields(def);
else
objectdef_rtti_interface_full(def);
end;
end;
end;
end;
@ -1152,7 +1156,7 @@ implementation
begin
if assigned(tobjectdef(def).childof) then
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)
else
published_write_rtti(tobjectdef(def).symtable,rt);