* Allow use of attributes on fields and properties in records and classes

compiler/pdecobj.pas

@@ -1084,7 +1084,7 @@ implementation
         vdoptions: tvar_dec_options;
         fieldlist: tfpobjectlist;
         rtti_attrs_def: trtti_attribute_list;
-
+        fldCount : Integer;
 
       procedure parse_const;
         begin
@@ -1242,7 +1242,6 @@ implementation
               end;
             _ID :
               begin
-                check_unbound_attributes;
                 if is_objcprotocol(current_structdef) and
                    ((idtoken=_REQUIRED) or
                     (idtoken=_OPTIONAL)) then
@@ -1323,7 +1322,6 @@ implementation
                       begin
                         if object_member_blocktype=bt_general then
                           begin
-                            rtti_attrs_def := nil;
                             if (idtoken=_GENERIC) and
                                 not (m_delphi in current_settings.modeswitches) and
                                 (
@@ -1367,13 +1365,34 @@ implementation
                                   include(vdoptions,vd_final);
                                 if threadvar_fields then
                                   include(vdoptions,vd_threadvar);
+                                // Record count
+                                fldCount:=FieldList.Count;
                                 read_record_fields(vdoptions,fieldlist,nil,hadgeneric);
+                                if assigned(rtti_attrs_def) then
+                                  begin
+                                  { read_record_fields can read a list of fields with the same type.
+                                    for the first fields, we simply copy. for the last one we bind.}
+                                  While (fldCount+1<FieldList.Count) do
+                                    begin
+                                    trtti_attribute_list.copyandbind(rtti_attrs_def,tfieldvarsym(fieldlist[FldCount]).rtti_attribute_list);
+                                    inc(fldcount);
+                                    end;
+                                  if fldCount<FieldList.Count then
+                                    trtti_attribute_list.bind(rtti_attrs_def,tfieldvarsym(fieldlist[FldCount]).rtti_attribute_list)
+                                  else
+                                    rtti_attrs_def.free;
+                                  end;
+                                rtti_attrs_def:=nil;
                               end;
                           end
                         else if object_member_blocktype=bt_type then
+                          begin
+                          check_unbound_attributes;
                           types_dec(true,hadgeneric, rtti_attrs_def)
+                          end
                         else if object_member_blocktype=bt_const then
                           begin
+                            check_unbound_attributes;
                             typedconstswritable:=false;
                             if final_fields then
                               begin
@@ -1394,9 +1413,6 @@ implementation
               end;
             _PROPERTY :
               begin
-                { for now attributes are only allowed on published properties }
-                if current_structdef.symtable.currentvisibility<>vis_published then
-                  check_unbound_attributes;
                 struct_property_dec(is_classdef, rtti_attrs_def);
                 fields_allowed:=false;
                 is_classdef:=false;

compiler/pmodules.pas

@@ -1270,6 +1270,12 @@ type
            add_synthetic_interface_classes_for_st(current_module.localsymtable);
            end;
 
+         { generate construction functions for all attributes in the unit:
+           this must be done before writing the VMTs because
+           during VMT writing  the extended field info is written }
+
+         generate_attr_constrs(current_module.used_rtti_attrs);
+
          { Generate VMTs }
          if Errorcount=0 then
            begin
@@ -1282,9 +1288,6 @@ type
          add_synthetic_method_implementations(current_module.globalsymtable);
          add_synthetic_method_implementations(current_module.localsymtable);
 
-         { generate construction functions for all attributes in the unit }
-         generate_attr_constrs(current_module.used_rtti_attrs);
-
          { if the unit contains ansi/widestrings, initialization and
            finalization code must be forced }
          force_init_final:=tglobalsymtable(current_module.globalsymtable).needs_init_final or

compiler/ptype.pas

@@ -697,6 +697,16 @@ implementation
         fields_allowed, is_classdef, classfields, threadvarfields: boolean;
         vdoptions: tvar_dec_options;
         rtti_attrs_def: trtti_attribute_list;
+        fldCount : Integer;
+
+      procedure check_unbound_attributes;
+        begin
+          if assigned(rtti_attrs_def) and (rtti_attrs_def.get_attribute_count>0) then
+            Message1(parser_e_unbound_attribute,trtti_attribute(rtti_attrs_def.rtti_attributes[0]).typesym.prettyname);
+          rtti_attrs_def.free;
+          rtti_attrs_def:=nil;
+        end;
+
       begin
         { empty record declaration ? }
         if (token=_SEMICOLON) then
@@ -722,6 +732,7 @@ implementation
           case token of
             _TYPE :
               begin
+                check_unbound_attributes;
                 consume(_TYPE);
                 member_blocktype:=bt_type;
 
@@ -731,6 +742,7 @@ implementation
               end;
             _VAR :
               begin
+                check_unbound_attributes;
                 consume(_VAR);
                 fields_allowed:=true;
                 member_blocktype:=bt_general;
@@ -740,6 +752,7 @@ implementation
               end;
             _THREADVAR :
               begin
+                check_unbound_attributes;
                 if not is_classdef then
                   begin
                     message(parser_e_threadvar_must_be_class);
@@ -755,6 +768,7 @@ implementation
               end;
             _CONST:
               begin
+                check_unbound_attributes;
                 consume(_CONST);
                 member_blocktype:=bt_const;
 
@@ -767,6 +781,7 @@ implementation
                 case idtoken of
                   _PRIVATE :
                     begin
+                      check_unbound_attributes;
                        consume(_PRIVATE);
                        current_structdef.symtable.currentvisibility:=vis_private;
                        include(current_structdef.objectoptions,oo_has_private);
@@ -778,6 +793,7 @@ implementation
                      end;
                    _PROTECTED :
                      begin
+                       check_unbound_attributes;
                        Message1(parser_e_not_allowed_in_record,tokeninfo^[_PROTECTED].str);
                        consume(_PROTECTED);
                        current_structdef.symtable.currentvisibility:=vis_protected;
@@ -790,6 +806,7 @@ implementation
                      end;
                    _PUBLIC :
                      begin
+                       check_unbound_attributes;
                        consume(_PUBLIC);
                        current_structdef.symtable.currentvisibility:=vis_public;
                        fields_allowed:=true;
@@ -800,6 +817,7 @@ implementation
                      end;
                    _PUBLISHED :
                      begin
+                       check_unbound_attributes;
                        Message(parser_e_no_record_published);
                        consume(_PUBLISHED);
                        current_structdef.symtable.currentvisibility:=vis_published;
@@ -844,6 +862,7 @@ implementation
                     else
                     if is_classdef and (idtoken=_OPERATOR) then
                       begin
+                        check_unbound_attributes;
                         pd:=parse_record_method_dec(current_structdef,is_classdef,false);
                         fields_allowed:=false;
                         is_classdef:=false;
@@ -874,7 +893,17 @@ implementation
                                   include(vdoptions,vd_check_generic);
                                 if threadvarfields then
                                   include(vdoptions,vd_threadvar);
+                                fldCount:=current_structdef.symtable.SymList.Count;
                                 read_record_fields(vdoptions,nil,nil,hadgeneric);
+                                if assigned(rtti_attrs_def) then
+                                  begin
+                                  While (fldCount+1<current_structdef.symtable.SymList.Count) do
+                                    begin
+                                    trtti_attribute_list.copyandbind(rtti_attrs_def,(current_structdef.symtable.SymList[fldCount] as tfieldvarsym).rtti_attribute_list);
+                                    inc(fldcount);
+                                    end;
+                                  trtti_attribute_list.bind(rtti_attrs_def,(current_structdef.symtable.SymList[fldCount] as tfieldvarsym).rtti_attribute_list);
+                                  end;
                               end;
                           end
                         else if member_blocktype=bt_type then
@@ -896,6 +925,7 @@ implementation
               end;
             _CLASS:
               begin
+                check_unbound_attributes;
                 is_classdef:=false;
                 { read class method/field/property }
                 consume(_CLASS);
@@ -914,6 +944,7 @@ implementation
             _PROCEDURE,
             _FUNCTION:
               begin
+                check_unbound_attributes;
                 if IsAnonOrLocal then
                   Message(parser_e_no_methods_in_local_anonymous_records);
                 pd:=parse_record_method_dec(current_structdef,is_classdef,hadgeneric);
@@ -923,6 +954,7 @@ implementation
               end;
             _CONSTRUCTOR :
               begin
+                check_unbound_attributes;
                 if IsAnonOrLocal then
                   Message(parser_e_no_methods_in_local_anonymous_records);
                 if not is_classdef and (current_structdef.symtable.currentvisibility <> vis_public) then
@@ -949,6 +981,7 @@ implementation
               end;
             _DESTRUCTOR :
               begin
+                check_unbound_attributes;
                 if IsAnonOrLocal then
                   Message(parser_e_no_methods_in_local_anonymous_records);
                 if not is_classdef then
@@ -969,6 +1002,13 @@ implementation
                 fields_allowed:=false;
                 is_classdef:=false;
               end;
+            _LECKKLAMMER:
+              begin
+                if m_prefixed_attributes in current_settings.modeswitches then
+                  parse_rttiattributes(rtti_attrs_def)
+                else
+                  consume(_ID);
+              end;
             _END :
               begin
 {$ifdef jvm}

compiler/symdef.pas

@@ -85,6 +85,7 @@ interface
           { if the attribute list is bound to a def or symbol }
           is_bound : Boolean;
           class procedure bind(var dangling,owned:trtti_attribute_list);
+          class procedure copyandbind(alist :trtti_attribute_list; var owned : trtti_attribute_list);
           procedure addattribute(atypesym:tsym;typeconstr:tdef;constructorcall:tnode;constref paras:array of tnode);
           procedure addattribute(attr:trtti_attribute);
           destructor destroy; override;
@@ -3313,6 +3314,29 @@ implementation
         dangling:=nil;
       end;
 
+    class procedure trtti_attribute_list.copyandbind(alist : trtti_attribute_list; var owned: trtti_attribute_list);
+    var
+      i,j : Integer;
+      attr,newattribute : trtti_attribute;
+    begin
+      if owned=Nil then
+        owned:=trtti_attribute_list.Create;
+      owned.is_bound:=True;
+      for i:=0 to aList.rtti_attributes.Count-1 do
+        begin
+        attr:=trtti_attribute(alist.rtti_attributes[i]);
+        newattribute:=trtti_attribute.Create;
+        newattribute.typesym:=attr.typesym;
+        newattribute.typeconstr:=attr.typeconstr;
+        newattribute.constructorcall:=attr.constructorcall.getcopy;
+        setlength(newattribute.paras,length(attr.paras));
+        for j:=0 to length(attr.paras)-1 do
+          newattribute.paras[j]:=attr.paras[j].getcopy;
+        owned.AddAttribute(newattribute);
+        end;
+      current_module.used_rtti_attrs.concatlistcopy(owned.rtti_attributes);
+    end;
+
 
     procedure trtti_attribute_list.addattribute(atypesym:tsym;typeconstr:tdef;constructorcall:tnode;constref paras:array of tnode);
       var