mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-13 02:29:36 +02:00
Adding support for indexed properties in extended RTTI
This commit is contained in:
Frederic Kehrein
Michael Van Canneyt
parent
51dcae0285
commit
59a1199110
@ -69,6 +69,7 @@ interface
|
||||
procedure write_callconv(tcb:ttai_typedconstbuilder;def:tabstractprocdef);
|
||||
procedure write_paralocs(tcb:ttai_typedconstbuilder;para:pcgpara);
|
||||
procedure write_param_flag(tcb:ttai_typedconstbuilder;parasym:tparavarsym);
|
||||
procedure write_param(tcb:ttai_typedconstbuilder;para:tparavarsym);
|
||||
procedure write_mop_offset_table(tcb:ttai_typedconstbuilder;def:tabstractrecorddef;mop:tmanagementoperator);
|
||||
procedure maybe_add_comment(tcb:ttai_typedconstbuilder;const comment : string); inline;
|
||||
public
|
||||
@ -333,32 +334,7 @@ implementation
|
||||
end;
|
||||
|
||||
for k:=0 to def.paras.count-1 do
|
||||
begin
|
||||
para:=tparavarsym(def.paras[k]);
|
||||
|
||||
maybe_add_comment(tcb,'RTTI: begin param '+para.prettyname);
|
||||
tcb.begin_anonymous_record('',defaultpacking,min(reqalign,SizeOf(PInt)),
|
||||
targetinfos[target_info.system]^.alignment.recordalignmin);
|
||||
|
||||
maybe_add_comment(tcb,#9'type');
|
||||
if is_open_array(para.vardef) or is_array_of_const(para.vardef) then
|
||||
write_rtti_reference(tcb,tarraydef(para.vardef).elementdef,fullrtti)
|
||||
else if para.vardef=cformaltype then
|
||||
write_rtti_reference(tcb,nil,fullrtti)
|
||||
else
|
||||
write_rtti_reference(tcb,para.vardef,fullrtti);
|
||||
maybe_add_comment(tcb,#9'flags');
|
||||
write_param_flag(tcb,para);
|
||||
|
||||
maybe_add_comment(tcb,#9'name');
|
||||
tcb.emit_pooled_shortstring_const_ref(para.realname);
|
||||
|
||||
maybe_add_comment(tcb,#9'locs');
|
||||
write_paralocs(tcb,@para.paraloc[callerside]);
|
||||
|
||||
tcb.end_anonymous_record;
|
||||
maybe_add_comment(tcb,'RTTI: end param '+para.prettyname);
|
||||
end;
|
||||
write_param(tcb,tparavarsym(def.paras[k]));
|
||||
|
||||
if not is_void(def.returndef) then
|
||||
begin
|
||||
@ -562,6 +538,33 @@ implementation
|
||||
tcb.emit_ord_const(paraspec,u16inttype);
|
||||
end;
|
||||
|
||||
procedure TRTTIWriter.write_param(tcb: ttai_typedconstbuilder;
|
||||
para: tparavarsym);
|
||||
begin
|
||||
maybe_add_comment(tcb,'RTTI: begin param '+para.prettyname);
|
||||
tcb.begin_anonymous_record('',defaultpacking,min(reqalign,SizeOf(PInt)),
|
||||
targetinfos[target_info.system]^.alignment.recordalignmin);
|
||||
|
||||
maybe_add_comment(tcb,#9'type');
|
||||
if is_open_array(para.vardef) or is_array_of_const(para.vardef) then
|
||||
write_rtti_reference(tcb,tarraydef(para.vardef).elementdef,fullrtti)
|
||||
else if para.vardef=cformaltype then
|
||||
write_rtti_reference(tcb,nil,fullrtti)
|
||||
else
|
||||
write_rtti_reference(tcb,para.vardef,fullrtti);
|
||||
maybe_add_comment(tcb,#9'flags');
|
||||
write_param_flag(tcb,para);
|
||||
|
||||
maybe_add_comment(tcb,#9'name');
|
||||
tcb.emit_pooled_shortstring_const_ref(para.realname);
|
||||
|
||||
maybe_add_comment(tcb,#9'locs');
|
||||
write_paralocs(tcb,@para.paraloc[callerside]);
|
||||
|
||||
tcb.end_anonymous_record;
|
||||
maybe_add_comment(tcb,'RTTI: end param '+para.prettyname);
|
||||
end;
|
||||
|
||||
|
||||
function compare_mop_offset_entry(item1,item2:pointer):longint;
|
||||
var
|
||||
@ -1062,12 +1065,40 @@ implementation
|
||||
sym:=tsym(st.SymList[i]);
|
||||
if (tsym(sym).typ=propertysym) and
|
||||
(sym.visibility in visibilities) and
|
||||
(tpropertysym(sym).parast=Nil) and
|
||||
(extended_rtti or (tpropertysym(sym).parast=Nil)) and
|
||||
not (sp_static in sym.symoptions) then
|
||||
inc(result);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure write_prop_params(tcb:ttai_typedconstbuilder;paramst:tsymtable);
|
||||
var
|
||||
paramtcb : ttai_typedconstbuilder;
|
||||
paramlbl : tasmlabel;
|
||||
paramdef : tdef;
|
||||
i : longint;
|
||||
begin
|
||||
tcb.start_internal_data_builder(current_asmdata.AsmLists[al_rtti],sec_rodata,'',paramtcb,paramlbl);
|
||||
|
||||
paramtcb.begin_anonymous_record('',defaultpacking,min(reqalign,SizeOf(PInt)),
|
||||
targetinfos[target_info.system]^.alignment.recordalignmin);
|
||||
|
||||
{ paramcount }
|
||||
paramtcb.emit_ord_const(paramst.symlist.count,u32inttype);
|
||||
for i:=0 to paramst.symlist.count-1 do
|
||||
begin
|
||||
if tsym(paramst.symlist[i]).typ<>paravarsym then
|
||||
Internalerror(2024103101);
|
||||
write_param(paramtcb,tparavarsym(paramst.symlist[i]));
|
||||
end;
|
||||
|
||||
|
||||
paramdef:=paramtcb.end_anonymous_record;
|
||||
tcb.finish_internal_data_builder(paramtcb,paramlbl,paramdef,sizeof(pint));
|
||||
|
||||
tcb.emit_tai(tai_const.Create_sym(paramlbl),voidpointertype);
|
||||
end;
|
||||
|
||||
function write_propinfo_data(tcb: ttai_typedconstbuilder; sym: tpropertysym): tdef;
|
||||
begin
|
||||
{ we can only easily reuse defs if the property is not stored,
|
||||
@ -1127,6 +1158,13 @@ implementation
|
||||
if addcomments then
|
||||
tcb.emit_comment(#9'proc types');
|
||||
tcb.emit_ord_const(proctypesinfo,u8inttype);
|
||||
{ index parameters }
|
||||
if addcomments then
|
||||
tcb.emit_comment(#9'indexed params');
|
||||
if extended_rtti and assigned(tpropertysym(sym).parast) then
|
||||
write_prop_params(tcb,sym.parast)
|
||||
else
|
||||
tcb.emit_tai(tai_const.create_nil_dataptr,voidpointertype);
|
||||
{ write reference to attribute table }
|
||||
if addcomments then
|
||||
tcb.emit_comment(#9'attributes');
|
||||
@ -1153,7 +1191,7 @@ implementation
|
||||
sym:=tsym(st.SymList[i]);
|
||||
if (sym.typ=propertysym) and
|
||||
(sym.visibility in visibilities) and
|
||||
(tpropertysym(sym).parast=Nil) and
|
||||
(extended_rtti or (tpropertysym(sym).parast=Nil)) and
|
||||
not (sp_static in sym.symoptions) then
|
||||
begin
|
||||
if extended_rtti then
|
||||
|
||||
@ -1092,6 +1092,16 @@ unit TypInfo;
|
||||
PPropListEx = ^TPropListEx;
|
||||
TPropListEx = array[0..{$ifdef cpu16}(32768 div sizeof(PPropInfoEx))-2{$else}65535{$endif}] of PPropInfoEx;
|
||||
|
||||
TPropParams =
|
||||
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||
packed
|
||||
{$ENDIF FPC_REQUIRES_PROPER_ALIGNMENT}
|
||||
record
|
||||
Count: LongInt;
|
||||
Params: array[0..0] of TVmtMethodParam;
|
||||
end;
|
||||
PPropParams = ^TPropParams;
|
||||
|
||||
{$PACKRECORDS 1}
|
||||
TPropInfo = packed record
|
||||
private
|
||||
@ -1114,6 +1124,8 @@ unit TypInfo;
|
||||
// 6 : true, constant index property
|
||||
PropProcs : Byte;
|
||||
|
||||
PropParams : PPropParams;
|
||||
|
||||
{$ifdef PROVIDE_ATTR_TABLE}
|
||||
AttributeTable : PAttributeTable;
|
||||
{$endif}
|
||||
|
||||
43
tests/test/texrtti19.pp
Normal file
43
tests/test/texrtti19.pp
Normal file
@ -0,0 +1,43 @@
|
||||
{$Mode ObjFpc}
|
||||
|
||||
uses TypInfo;
|
||||
|
||||
type
|
||||
{$RTTI EXPLICIT
|
||||
FIELDS([vcPublic])
|
||||
PROPERTIES([vcPublic,vcPublished])
|
||||
METHODS([vcPublic,vcPublished])
|
||||
}
|
||||
TTestClass = class
|
||||
public
|
||||
fa:integer;
|
||||
function MyMethod(const arg1: Integer): Integer;
|
||||
property TestIProp[const i: Longint]: Integer read MyMethod;
|
||||
property TestProp: Integer read fa;
|
||||
end;
|
||||
|
||||
function TTestClass.MyMethod(const arg1: Integer): Integer;
|
||||
begin
|
||||
Result := arg1;
|
||||
end;
|
||||
|
||||
var
|
||||
pcd: PClassData;
|
||||
begin
|
||||
pcd:=PClassData(GetTypeData(TypeInfo(TTestClass)));
|
||||
if pcd^.ExRTTITable^.PropCount <> 2 then
|
||||
Halt(1);
|
||||
if not assigned(pcd^.ExRTTITable^.Prop[0]^.Info^.PropParams) then
|
||||
Halt(2);
|
||||
if pcd^.ExRTTITable^.Prop[0]^.Info^.PropParams^.Count<>1 then
|
||||
Halt(3);
|
||||
if pcd^.ExRTTITable^.Prop[0]^.Info^.PropParams^.Params[0].Name<>'i' then
|
||||
Halt(4);
|
||||
if not (pfconst in pcd^.ExRTTITable^.Prop[0]^.Info^.PropParams^.Params[0].flags) then
|
||||
Halt(5);
|
||||
if pcd^.ExRTTITable^.Prop[0]^.Info^.PropParams^.Params[0].ParamType^^.Name<>'LongInt' then
|
||||
Halt(6);
|
||||
if assigned(pcd^.ExRTTITable^.Prop[1]^.Info^.PropParams) then
|
||||
Halt(7);
|
||||
WriteLn('Ok');
|
||||
end.
|
||||
35
tests/test/texrtti20.pp
Normal file
35
tests/test/texrtti20.pp
Normal file
@ -0,0 +1,35 @@
|
||||
{$Mode ObjFpc}
|
||||
|
||||
uses TypInfo;
|
||||
|
||||
type
|
||||
{$RTTI EXPLICIT
|
||||
FIELDS([vcPublic])
|
||||
PROPERTIES([vcPublic,vcPublished])
|
||||
METHODS([vcPublic,vcPublished])
|
||||
}
|
||||
TTestClass = class
|
||||
public
|
||||
fa:integer;
|
||||
function MyMethod(const arg1: Integer): Integer;
|
||||
property TestIProp[const i: Longint]: Integer read MyMethod;
|
||||
published
|
||||
property TestProp: Integer read fa;
|
||||
end;
|
||||
|
||||
function TTestClass.MyMethod(const arg1: Integer): Integer;
|
||||
begin
|
||||
Result := arg1;
|
||||
end;
|
||||
|
||||
var
|
||||
pcd: PClassData;
|
||||
begin
|
||||
pcd:=PClassData(GetTypeData(TypeInfo(TTestClass)));
|
||||
WriteLn(pcd^.PropertyTable^.PropCount);
|
||||
if pcd^.PropertyTable^.PropCount <> 1 then
|
||||
Halt(1);
|
||||
if assigned(pcd^.PropertyTable^.Prop[0]^.PropParams) then
|
||||
Halt(2);
|
||||
WriteLn('Ok');
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user