Ver Fonte

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

git-svn-id: trunk@42392 -
svenbarth há 6 anos atrás
pai
commit
d9d2515ada
3 ficheiros alterados com 15 adições e 6 exclusões
  1. 1 3
      compiler/pdecl.pas
  2. 1 3
      compiler/pdecobj.pas
  3. 13 0
      compiler/symdef.pas

+ 1 - 3
compiler/pdecl.pas

@@ -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

+ 1 - 3
compiler/pdecobj.pas

@@ -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 - 0
compiler/symdef.pas

@@ -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