paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-07 03:46:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

* store the parameter nodes in the attribute object as well (we need to write them to the RTTI as well as store them in the PPU)

Browse Source 
git-svn-id: trunk@42382 -
This commit is contained in:
svenbarth 2019-07-12 22:06:34 +00:00
parent 3a20178d96
commit 0e04d9b4de
2 changed files with 46 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
compiler/pdecl.pas
View File

@ -431,7 +431,9 @@ implementation
end; end;
var var
p,paran,pcalln : tnode; p,paran,pcalln,ptmp : tnode;
pcount : sizeint;
paras : array of tnode;
od : tobjectdef; od : tobjectdef;
constrsym : tsymentry; constrsym : tsymentry;
typesym : ttypesym; typesym : ttypesym;
@ -451,6 +453,29 @@ implementation
paran:=read_attr_paras; paran:=read_attr_paras;
paras:=nil;
if assigned(paran) then
begin
ptmp:=paran;
pcount:=0;
while assigned(ptmp) do
begin
inc(pcount);
ptmp:=tcallparanode(ptmp).right;
end;
setlength(paras,pcount);
ptmp:=paran;
pcount:=0;
while assigned(ptmp) do
begin
if not is_constnode(tcallparanode(ptmp).left) then
internalerror(2019070601);
paras[high(paras)-pcount]:=tcallparanode(ptmp).left.getcopy;
inc(pcount);
ptmp:=tcallparanode(ptmp).right;
end;
end;
{ Search the tprocdef of the constructor which has to be called. } { Search the tprocdef of the constructor which has to be called. }
constrsym:=find_create_constructor(od); constrsym:=find_create_constructor(od);
if constrsym.typ<>procsym then if constrsym.typ<>procsym then
@ -466,7 +491,7 @@ implementation
to the property which is defined next. } to the property which is defined next. }
if not assigned(rtti_attrs_def) then if not assigned(rtti_attrs_def) then
rtti_attrs_def:=trtti_attribute_list.create; rtti_attrs_def:=trtti_attribute_list.create;
rtti_attrs_def.addattribute(typesym,pcalln); rtti_attrs_def.addattribute(typesym,pcalln,paras);
end; end;
end end
else else

21
compiler/symdef.pas
View File

@ -63,12 +63,14 @@ interface
trtti_attribute = class trtti_attribute = class
typesym : tsym; typesym : tsym;
constructorcall : tnode; constructorcall : tnode;
paras : array of tnode;
symbolname : string; symbolname : string;
destructor destroy;override;
end; end;
trtti_attribute_list = class trtti_attribute_list = class
rtti_attributes : TFPObjectList; rtti_attributes : TFPObjectList;
procedure addattribute(atypesym:tsym;constructorcall:tnode); procedure addattribute(atypesym:tsym;constructorcall:tnode;constref paras:array of tnode);
destructor destroy; override; destructor destroy; override;
function get_attribute_count:longint; function get_attribute_count:longint;
end; end;
@ -2889,15 +2891,30 @@ implementation
TRTTI_ATTRIBUTE_LIST TRTTI_ATTRIBUTE_LIST
****************************************************************************} ****************************************************************************}
procedure trtti_attribute_list.addattribute(atypesym:tsym;constructorcall:tnode);
destructor trtti_attribute.destroy;
var
n : tnode;
begin
for n in paras do
n.free;
inherited destroy;
end;
procedure trtti_attribute_list.addattribute(atypesym:tsym;constructorcall:tnode;constref paras:array of tnode);
var var
newattribute : trtti_attribute; newattribute : trtti_attribute;
i : sizeint;
begin begin
if not assigned(rtti_attributes) then if not assigned(rtti_attributes) then
rtti_attributes:=TFPObjectList.Create(true); rtti_attributes:=TFPObjectList.Create(true);
newattribute:=trtti_attribute.Create; newattribute:=trtti_attribute.Create;
newattribute.typesym:=atypesym; newattribute.typesym:=atypesym;
newattribute.constructorcall:=constructorcall; newattribute.constructorcall:=constructorcall;
setlength(newattribute.paras,length(paras));
for i:=0 to high(paras) do
newattribute.paras[i]:=paras[i];
rtti_attributes.Add(newattribute); rtti_attributes.Add(newattribute);
end; end;