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

* move binding of a dangling attribute list to a sym's/def's attribute list to a class procedure of trtti_attribute_list

Browse Source 
git-svn-id: trunk@42392 -
This commit is contained in:
svenbarth 2019-07-12 22:07:11 +00:00
parent 5cea374255
commit d9d2515ada
3 changed files with 15 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
compiler/pdecl.pas
View File

@ -1056,9 +1056,7 @@ implementation
if assigned(rtti_attrs_def) then
begin
add_synthetic_rtti_function_declarations(rtti_attrs_def,hdef.typesym.Name);
tobjectdef(hdef).rtti_attribute_list:=rtti_attrs_def;
rtti_attrs_def.is_bound:=true;
rtti_attrs_def := nil;
trtti_attribute_list.bind(rtti_attrs_def,tobjectdef(hdef).rtti_attribute_list);
end;
{ In case of an objcclass, verify that all methods have a message

4
compiler/pdecobj.pas
View File

@ -217,9 +217,7 @@ implementation
if assigned(rtti_attrs_def) then
begin
add_synthetic_rtti_function_declarations(rtti_attrs_def,current_structdef.RttiName+'_'+p.RealName);
p.rtti_attribute_list := rtti_attrs_def;
p.rtti_attribute_list.is_bound:=true;
rtti_attrs_def:=nil;
trtti_attribute_list.bind(rtti_attrs_def,p.rtti_attribute_list);
end;
{ hint directives, these can be separated by semicolons here,

13
compiler/symdef.pas
View File

@ -72,6 +72,7 @@ interface
rtti_attributes : TFPObjectList;
{ if the attribute list is bound to a def or symbol }
is_bound : Boolean;
class procedure bind(var dangling,owned:trtti_attribute_list);
procedure addattribute(atypesym:tsym;constructorcall:tnode;constref paras:array of tnode);
destructor destroy; override;
function get_attribute_count:longint;
@ -2904,6 +2905,18 @@ implementation
inherited destroy;
end;
class procedure trtti_attribute_list.bind(var dangling,owned:trtti_attribute_list);
begin
if assigned(owned) then
internalerror(2019071001);
if not assigned(dangling) then
exit;
if dangling.is_bound then
internalerror(2019071002);
dangling.is_bound:=true;
owned:=dangling;
dangling:=nil;
end;
procedure trtti_attribute_list.addattribute(atypesym:tsym;constructorcall:tnode;constref paras:array of tnode);
var