* Do not include class and array properties in RTTI

This commit is contained in:
Michaël Van Canneyt 2024-07-27 08:21:11 +02:00
parent b3b4343e6b
commit 87137a4aaa
3 changed files with 81 additions and 3 deletions

View File

@ -953,6 +953,7 @@ implementation
tbltcb : ttai_typedconstbuilder;
tbllab : tasmlabel;
tbldef : tdef;
visbyte : byte;
procedure writeaccessproc(tcb: ttai_typedconstbuilder; pap:tpropaccesslisttypes; shiftvalue : byte; unsetvalue: byte);
var
@ -1060,7 +1061,9 @@ implementation
begin
sym:=tsym(st.SymList[i]);
if (tsym(sym).typ=propertysym) and
(sym.visibility in visibilities) then
(sym.visibility in visibilities) and
(tpropertysym(sym).parast=Nil) and
not (sp_static in sym.symoptions) then
inc(result);
end;
end;
@ -1149,7 +1152,9 @@ implementation
begin
sym:=tsym(st.SymList[i]);
if (sym.typ=propertysym) and
(sym.visibility in visibilities) then
(sym.visibility in visibilities) and
(tpropertysym(sym).parast=Nil) and
not (sp_static in sym.symoptions) then
begin
if extended_rtti then
begin
@ -1165,7 +1170,8 @@ implementation
targetinfos[target_info.system]^.alignment.recordalignmin);
{ write visiblity flags for extended RTTI }
maybe_add_comment(tcb,#9'visibility flags');
tcb.emit_ord_const(byte(visibility_to_rtti_flags(sym.visibility)),u8inttype);
visbyte:=byte(visibility_to_rtti_flags(sym.visibility));
tcb.emit_ord_const(visByte,u8inttype);
{ create separate constant builder }
current_asmdata.getglobaldatalabel(tbllab);
tbltcb:=ctai_typedconstbuilder.create([tcalo_is_lab,tcalo_make_dead_strippable]);

36
tests/test/texrtti17.pp Normal file
View File

@ -0,0 +1,36 @@
program texrtti17;
{$mode objfpc}
{ Test that class properties are not returned in RTTI }
uses typinfo, uexrttiutil;
{$RTTI INHERIT
METHODS(DefaultMethodRttiVisibility)
FIELDS(DefaultFieldRttiVisibility)
PROPERTIES(DefaultPropertyRttiVisibility)
}
Type
T1 = Class(TObject)
class function getsomething : integer; static;
class property Something : Integer Read GetSomething;
end;
class function T1.getsomething : integer;
begin
Result:=0;
end;
var
aCount : Integer;
P: PPropListEx;
begin
aCount:=GetPropListEx(T1,P);
AssertEquals('class property not in RTTI properties',0,aCount);
end.

36
tests/test/texrtti18.pp Normal file
View File

@ -0,0 +1,36 @@
program texrtti17;
{$mode objfpc}
{ Test that class properties are not returned in RTTI }
uses typinfo, uexrttiutil;
{$RTTI INHERIT
METHODS(DefaultMethodRttiVisibility)
FIELDS(DefaultFieldRttiVisibility)
PROPERTIES(DefaultPropertyRttiVisibility)
}
Type
T1 = Class(TObject)
class function getsomething : integer; static;
class property Something : Integer Read GetSomething;
end;
class function T1.getsomething : integer;
begin
Result:=0;
end;
var
aCount : Integer;
P: PPropListEx;
begin
aCount:=GetPropListEx(T1,P);
AssertEquals('class property not in RTTI properties',0,aCount);
end.