mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-05-31 04:42:34 +02:00
* 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)
git-svn-id: trunk@42382 -
This commit is contained in:
parent
3a20178d96
commit
0e04d9b4de
@ -431,7 +431,9 @@ implementation
|
||||
end;
|
||||
|
||||
var
|
||||
p,paran,pcalln : tnode;
|
||||
p,paran,pcalln,ptmp : tnode;
|
||||
pcount : sizeint;
|
||||
paras : array of tnode;
|
||||
od : tobjectdef;
|
||||
constrsym : tsymentry;
|
||||
typesym : ttypesym;
|
||||
@ -451,6 +453,29 @@ implementation
|
||||
|
||||
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. }
|
||||
constrsym:=find_create_constructor(od);
|
||||
if constrsym.typ<>procsym then
|
||||
@ -466,7 +491,7 @@ implementation
|
||||
to the property which is defined next. }
|
||||
if not assigned(rtti_attrs_def) then
|
||||
rtti_attrs_def:=trtti_attribute_list.create;
|
||||
rtti_attrs_def.addattribute(typesym,pcalln);
|
||||
rtti_attrs_def.addattribute(typesym,pcalln,paras);
|
||||
end;
|
||||
end
|
||||
else
|
||||
|
@ -63,12 +63,14 @@ interface
|
||||
trtti_attribute = class
|
||||
typesym : tsym;
|
||||
constructorcall : tnode;
|
||||
paras : array of tnode;
|
||||
symbolname : string;
|
||||
destructor destroy;override;
|
||||
end;
|
||||
|
||||
trtti_attribute_list = class
|
||||
rtti_attributes : TFPObjectList;
|
||||
procedure addattribute(atypesym:tsym;constructorcall:tnode);
|
||||
procedure addattribute(atypesym:tsym;constructorcall:tnode;constref paras:array of tnode);
|
||||
destructor destroy; override;
|
||||
function get_attribute_count:longint;
|
||||
end;
|
||||
@ -2889,15 +2891,30 @@ implementation
|
||||
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
|
||||
newattribute : trtti_attribute;
|
||||
i : sizeint;
|
||||
begin
|
||||
if not assigned(rtti_attributes) then
|
||||
rtti_attributes:=TFPObjectList.Create(true);
|
||||
newattribute:=trtti_attribute.Create;
|
||||
newattribute.typesym:=atypesym;
|
||||
newattribute.constructorcall:=constructorcall;
|
||||
setlength(newattribute.paras,length(paras));
|
||||
for i:=0 to high(paras) do
|
||||
newattribute.paras[i]:=paras[i];
|
||||
rtti_attributes.Add(newattribute);
|
||||
end;
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user