mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-16 11:49:22 +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;
|
tbltcb : ttai_typedconstbuilder;
|
||||||
tbllab : tasmlabel;
|
tbllab : tasmlabel;
|
||||||
tbldef : tdef;
|
tbldef : tdef;
|
||||||
|
visbyte : byte;
|
||||||
|
|
||||||
procedure writeaccessproc(tcb: ttai_typedconstbuilder; pap:tpropaccesslisttypes; shiftvalue : byte; unsetvalue: byte);
|
procedure writeaccessproc(tcb: ttai_typedconstbuilder; pap:tpropaccesslisttypes; shiftvalue : byte; unsetvalue: byte);
|
||||||
var
|
var
|
||||||
@ -1060,7 +1061,9 @@ implementation
|
|||||||
begin
|
begin
|
||||||
sym:=tsym(st.SymList[i]);
|
sym:=tsym(st.SymList[i]);
|
||||||
if (tsym(sym).typ=propertysym) and
|
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);
|
inc(result);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
@ -1149,7 +1152,9 @@ implementation
|
|||||||
begin
|
begin
|
||||||
sym:=tsym(st.SymList[i]);
|
sym:=tsym(st.SymList[i]);
|
||||||
if (sym.typ=propertysym) and
|
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
|
begin
|
||||||
if extended_rtti then
|
if extended_rtti then
|
||||||
begin
|
begin
|
||||||
@ -1165,7 +1170,8 @@ implementation
|
|||||||
targetinfos[target_info.system]^.alignment.recordalignmin);
|
targetinfos[target_info.system]^.alignment.recordalignmin);
|
||||||
{ write visiblity flags for extended RTTI }
|
{ write visiblity flags for extended RTTI }
|
||||||
maybe_add_comment(tcb,#9'visibility flags');
|
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 }
|
{ create separate constant builder }
|
||||||
current_asmdata.getglobaldatalabel(tbllab);
|
current_asmdata.getglobaldatalabel(tbllab);
|
||||||
tbltcb:=ctai_typedconstbuilder.create([tcalo_is_lab,tcalo_make_dead_strippable]);
|
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