mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-15 07:29:34 +02:00
* Do not include class and array properties in RTTI
This commit is contained in:
parent
b3b4343e6b
commit
87137a4aaa
@ -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
36
tests/test/texrtti17.pp
Normal 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
36
tests/test/texrtti18.pp
Normal 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.
|
||||
|
Loading…
Reference in New Issue
Block a user