compiler: reintegrate branch http://svn.freepascal.org/svn/fpc/branches/paul/extended_records

------------------------------------------------------------------------
r16513 compiler: add support for visibility blocks in records and type, const declarations:
  - add parse_record_members function to parse record blocks based on parse_object_members code
  - disable published section in records
  - rename in_class argument in some functions to in_structure because the same code can work for records now which are not classes
------------------------------------------------------------------------
r16514 compiler: check visibility of record members, allow access to record consts and types:
  - add searchsym_in_record function
  - change is_visible_for_object to accept tabstractrecorddef instead of tobjectdef arguments because records also have visibility sections now
  - change arguments in do_member_read, do_proc_call to tabstractrecorddef from tobjectdef to accept records
  - rename classh arguments to structh and change their type to tabstractrecorddef to show that they can accept records now too
  - move RttiName from tobjectdef to tabstractrecorddef
------------------------------------------------------------------------
r16515 compiler: add current_structdef: tabstractrecorddef and point current_objectdef to it
------------------------------------------------------------------------
r16516 compiler: allow access other record symbols than fields, first extended records tests
------------------------------------------------------------------------
r16519 compiler: 
  - move objname, objrealname fields from tobjectdef to tabstractrecorddef, 
  - load and save them from/to ppu file, 
  - use tabstarctrecorddef in some more places where previously code worked for tobjectdef
  - change push_nested_hierarchy, pop_nested_hierarchy to handle records too
------------------------------------------------------------------------
r16526 compiler: implement record methods and class methods:
  - rename tprocdef._class to tprocdef.struct and change the type from tobjectdef to tabstractrecorddef because methods can belong not to classes only now but to records too
  - replace in many places use of current_objectdef to current_structdef with typcast where is needed
  - add an argument to comp_expr, expr, factor, sub_expr to notify that we are searching type only symbol to solve the problem with records,objects,classes which contains fields with the same name as previosly declared type (like:
  HWND = type Handle;
  rec = record 
    hWnd: HWND;
  end;)
  - disable check in factor_read_id which was made for object that only static fields can be accessed as TObjectType.FieldName outside the object because it makes SizeOf(TObjectType.FieldName) imposible and since the same method was extended to handle records it also breaks a52 package compilation
  - rename tcallcandidates.collect_overloads_in_class to tcallcandidates.collect_overloads_in_struct and addapt the code to handle overloads in records too
  - fix searchsym_type to search also in object ancestors if we found an object symtable
  - add pd_record, pd_notrecord flags to mark procedure modifies which can or can't be used with records. Disallow the next modifiers for records: abstract, dynamic, export, external, far, far16, final, forward, internconst, internproc, interrupt, message, near, override, public, reintroduce, virtual, weakexternal,
Allow the next modifiers for records: static
------------------------------------------------------------------------
r16530 compiler: fix compilation problems caused by tprocdef._class -> tprocdef.struct rename which was found by make fullcycle
------------------------------------------------------------------------
r16531 compiler: redo searchsym_type:
  - remove complex condition which was used previosly to decide whether objectsymtable or recordsymtable requires a search for type or not - they require a search because contains types (although not all object types)
  - don't search only for typesym but for other symbols too - for example UnitSym.TypeSym or ConstSym..ConstSym are also valid types. Skip the next symtypes during the search because they can't be used in type declaration: fieldvarsym, paravarsym, propertysym, procsym, labelsym
------------------------------------------------------------------------
r16541 compiler: move objectoptions to tabstractrecorddef because it will be needed for records too
------------------------------------------------------------------------
r16542 compiler: remove unneeded checks and typecasting caused by move of objectoptions into tabstractrecorddef
------------------------------------------------------------------------
r16543 compiler: move constructor, destructor parsers to interface section to allow future use by records + change current_objectdef to current_structdef for the same reason, make constructor return type = record for records
r16544 compiler: start parsing of record constructors and destructors:
  - disallow record destructor
  - raise internal error for constructor because it is not yet implemented
  - handle class constructors and destructors for records
  - move find_procdef_bytype to tabstractpointerdef
------------------------------------------------------------------------
r16545 compiler: fix static fields creation and access for records
+ extend test to check class constructor/destructor for records and static fields access
------------------------------------------------------------------------
r16546 tests: add a test which checks that records destructors are not allowed
------------------------------------------------------------------------
r16547 compiler: rename aclass->astruct in read_property_dec because records will have properties too
------------------------------------------------------------------------
r16548 compiler: implement properties in records:
  - rename property_dec from pdecobj to struct_property_dec because pdecl also has property_dec and move it to interface to use by records + allow properties for records
  - use struct_property_dec in record parser
  - change structh type from objectdef to abstractrecorddef in read_property_dec to use by records
  - disallow stored and default modifiers for records because records are not used for streaming
  - fix misuse of search_sym_in_class for records in few places
------------------------------------------------------------------------
r16550 compiler: disallow regular class methods in records and allow only static class methods. delphi do so and it is logical because records have no inheritance. + tests
------------------------------------------------------------------------
r16560 compiler: a trial to implement record constructor
  - map self to constructor result
  - don't push vmt for records

At the moment generated assembler has errors although node tree is correct
------------------------------------------------------------------------
r16561 compiler: 
  - add mode switch extendedrecords to allow/disallow extended records syntax, add this mode switch to delphi mode by default
  - disable/enable extended records parsing based on extendedreocrds mode switch
------------------------------------------------------------------------
r16562 compiler: fix record constructor return type when parsing procedure declaration
------------------------------------------------------------------------
r16568 compiler: partly revert r16560 and disable (at least temporary) constructors in records
------------------------------------------------------------------------
r16569 test: add records Self test
------------------------------------------------------------------------
r16570 compiler: generate debug info for record methods:
  - extended write_symtable_procdefs to handle record definitions
  - fix stabs info generator to use prefixed symbol names for record methods, also handle records static symbols the same way as for object types
  - fix dwarf info record generation: add visibility info and write methods, also prefix record members the same way as object members

git-svn-id: trunk@16574 -

.gitattributes

@@ -9323,6 +9323,12 @@ tests/test/tenum3.pp svneol=native#text/plain
 tests/test/tenum4.pp svneol=native#text/plain
 tests/test/tenum5.pp svneol=native#text/plain
 tests/test/tenumerators1.pp svneol=native#text/pascal
+tests/test/terecs1.pp svneol=native#text/pascal
+tests/test/terecs2.pp svneol=native#text/pascal
+tests/test/terecs3.pp svneol=native#text/pascal
+tests/test/terecs4.pp svneol=native#text/pascal
+tests/test/terecs5.pp svneol=native#text/pascal
+tests/test/terecs_u1.pp svneol=native#text/pascal
 tests/test/testcmem.pp svneol=native#text/plain
 tests/test/testda1.pp svneol=native#text/plain
 tests/test/testfpuc.pp svneol=native#text/plain

compiler/arm/cgcpu.pas

@@ -2452,7 +2452,7 @@ unit cgcpu;
           if (procdef.extnumber=$ffff) then
             Internalerror(200006139);
           { call/jmp  vmtoffs(%eax) ; method offs }
-          reference_reset_base(href,NR_R12,procdef._class.vmtmethodoffset(procdef.extnumber),sizeof(pint));
+          reference_reset_base(href,NR_R12,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
           cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R12);
           list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,NR_R12));
         end;
@@ -2462,7 +2462,7 @@ unit cgcpu;
       begin
         if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
           Internalerror(200006137);
-        if not assigned(procdef._class) or
+        if not assigned(procdef.struct) or
            (procdef.procoptions*[po_classmethod, po_staticmethod,
              po_methodpointer, po_interrupt, po_iocheck]<>[]) then
           Internalerror(200006138);

compiler/dbgbase.pas

@@ -527,9 +527,9 @@ implementation
                   if assigned(tprocdef(def).localst) then
                     write_symtable_procdefs(list,tprocdef(def).localst);
                 end;
-              objectdef :
+              objectdef,recorddef :
                 begin
-                  write_symtable_procdefs(list,tobjectdef(def).symtable);
+                  write_symtable_procdefs(list,tabstractrecorddef(def).symtable);
                 end;
             end;
           end;

compiler/dbgdwarf.pas

@@ -1654,8 +1654,8 @@ implementation
 
     procedure TDebugInfoDwarf.appenddef_record(list:TAsmList;def:trecorddef);
       begin
-        if assigned(def.typesym) then
-          appenddef_record_named(list,def,symname(def.typesym))
+        if assigned(def.objname) then
+          appenddef_record_named(list,def,def.objname^)
         else
           appenddef_record_named(list,def,'');
       end;
@@ -1674,6 +1674,11 @@ implementation
             ]);
         finish_entry;
         def.symtable.symList.ForEachCall(@enum_membersyms_callback,nil);
+        { don't know whether external record declaration is allow but if it so then
+          do the same as we do for other object types - skip procdef info generation
+          for external defs (Paul Ishenin) }
+        if not(oo_is_external in def.objectoptions) then
+          write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],def.symtable);
         finish_children;
       end;
 
@@ -2000,7 +2005,7 @@ implementation
         in_currentunit:=def.in_currentunit;
 
         if not in_currentunit and
-          (def.owner.symtabletype<>objectsymtable) then
+          not (def.owner.symtabletype in [objectsymtable,recordsymtable]) then
           exit;
 
         { happens for init procdef of units without init section }
@@ -2015,7 +2020,7 @@ implementation
         defnumberlist.Add(def);
 
         { Write methods and only in the scope of their parent objectdefs.  }
-        if (def.owner.symtabletype=objectsymtable) then
+        if (def.owner.symtabletype in [objectsymtable,recordsymtable]) then
           begin
             { this code can also work for nested procdefs, but is not yet
               activated for those because there is no clear advantage yet to
@@ -2034,7 +2039,7 @@ implementation
         def.dbg_state:=dbg_state_writing;
 
         current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Procdef '+def.fullprocname(true))));
-        if not is_objc_class_or_protocol(def._class) then
+        if not is_objc_class_or_protocol(def.struct) then
           append_entry(DW_TAG_subprogram,true,
             [DW_AT_name,DW_FORM_string,symname(def.procsym)+#0
             { data continues below }
@@ -2065,7 +2070,7 @@ implementation
           append_attribute(DW_AT_external,DW_FORM_flag,[true]);
         { Abstract or virtual/overriding method.  }
         if (([po_abstractmethod, po_virtualmethod, po_overridingmethod] * def.procoptions) <> []) and
-           not is_objc_class_or_protocol(def._class) then
+           not is_objc_class_or_protocol(def.struct) then
           begin
             if not(po_abstractmethod in def.procoptions) then
               append_attribute(DW_AT_virtuality,DW_FORM_data1,[ord(DW_VIRTUALITY_virtual)])
@@ -2081,7 +2086,7 @@ implementation
           end;
 
         { accessibility: public/private/protected }
-        if (def.owner.symtabletype=objectsymtable) then
+        if (def.owner.symtabletype in [objectsymtable,recordsymtable]) then
           append_visibility(def.visibility);
 
         { Return type.  }
@@ -2487,7 +2492,7 @@ implementation
           end;
         current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
         current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(fieldoffset));
-        if (sym.owner.symtabletype=objectsymtable) then
+        if (sym.owner.symtabletype in [objectsymtable,recordsymtable]) then
           append_visibility(sym.visibility);
 
         append_labelentry_ref(DW_AT_type,def_dwarf_lab(def));
@@ -2675,7 +2680,7 @@ implementation
         if not get_symlist_sym_offset(symlist,tosym,offset) then
           exit;
 
-        if (tosym.owner.symtabletype<>objectsymtable) then
+        if not (tosym.owner.symtabletype in [objectsymtable,recordsymtable]) then
           begin
             if (tosym.typ=fieldvarsym) then
               internalerror(2009031404);
@@ -3130,7 +3135,7 @@ implementation
           result:=tobjectdef(ttypesym(sym).typedef).objextname^
         else if (ds_dwarf_method_class_prefix in current_settings.debugswitches) and
                 (sym.typ=procsym) and
-                (tprocsym(sym).owner.symtabletype=objectsymtable) then
+                (tprocsym(sym).owner.symtabletype in [objectsymtable,recordsymtable]) then
           result:=tprocsym(sym).owner.name^+'__'+sym.name
         else
           result:=sym.name;

compiler/dbgstabs.pas

@@ -66,7 +66,7 @@ interface
         procedure write_sym_stabstr(list:TAsmList;sym:tsym;const ss:ansistring);
         { tdef writing }
         function  def_stab_number(def:tdef):string;
-        function  def_stab_classnumber(def:tobjectdef):string;
+        function  def_stab_classnumber(def:tabstractrecorddef):string;
         function  def_var_value(const s:string;arg:pointer):string;
         function  def_stabstr_evaluate(def:tdef;const s:string;const vars:array of string):ansistring;
         procedure write_def_stabstr(list:TAsmList;def:tdef;const ss:ansistring);
@@ -314,11 +314,11 @@ implementation
       end;
 
 
-    function TDebugInfoStabs.def_stab_classnumber(def:tobjectdef):string;
+    function TDebugInfoStabs.def_stab_classnumber(def:tabstractrecorddef):string;
       begin
         if def.stab_number=0 then
           def_stab_number(def);
-        if (def.objecttype=odt_class) then
+        if (def.typ=objectdef) and (tobjectdef(def).objecttype=odt_class) then
           result:=tostr(def.stab_number-1)
         else
           result:=tostr(def.stab_number);
@@ -414,7 +414,7 @@ implementation
                lindex := pd.extnumber;
                {doesnt seem to be necessary
                lindex := lindex or $80000000;}
-               virtualind := '*'+tostr(lindex)+';'+def_stab_classnumber(pd._class)+';'
+               virtualind := '*'+tostr(lindex)+';'+def_stab_classnumber(pd.struct)+';'
              end
             else
              virtualind := '.';
@@ -783,7 +783,7 @@ implementation
         else
           do_write_object(list,def);
         { VMT symbol }
-        if (oo_has_vmt in tobjectdef(def).objectoptions) and
+        if (oo_has_vmt in def.objectoptions) and
            assigned(def.owner) and
            assigned(def.owner.name) then
           list.concat(Tai_stab.create(stab_stabs,strpnew('"vmt_'+GetSymTableName(def.owner)+tobjectdef(def).objname^+':S'+
@@ -1109,7 +1109,7 @@ implementation
           RType := 'f';
         if assigned(def.owner) then
           begin
-            if (def.owner.symtabletype = objecTSymtable) then
+            if (def.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
               obj := GetSymTableName(def.owner)+'__'+GetSymName(def.procsym);
             if not(cs_gdb_valgrind in current_settings.globalswitches) and
                (def.owner.symtabletype=localsymtable) and
@@ -1197,7 +1197,7 @@ implementation
         ss : ansistring;
       begin
         ss:='';
-        if (sym.owner.symtabletype=objecTSymtable) and
+        if (sym.owner.symtabletype in [ObjectSymtable,recordsymtable]) and
            (sp_static in sym.symoptions) then
           ss:=sym_stabstr_evaluate(sym,'"${ownername}__${name}:S$1",${N_LCSYM},0,${line},${mangledname}',
               [def_stab_number(sym.vardef)]);
@@ -1345,13 +1345,13 @@ implementation
                 end
             else
               begin
-                if not(is_class(tprocdef(sym.owner.defowner)._class)) then
+                if not(is_class(tprocdef(sym.owner.defowner).struct)) then
                   c:='v'
                 else
                   c:='p';
                 if (sym.localloc.loc=LOC_REFERENCE) then
                   ss:=sym_stabstr_evaluate(sym,'"$$t:$1",${N_TSYM},0,0,$2',
-                        [c+def_stab_number(tprocdef(sym.owner.defowner)._class),tostr(sym.localloc.reference.offset)])
+                        [c+def_stab_number(tprocdef(sym.owner.defowner).struct),tostr(sym.localloc.reference.offset)])
                 else
                   begin
                     if (c='p') then
@@ -1360,7 +1360,7 @@ implementation
                       c:='a';
                     regidx:=findreg_by_number(sym.localloc.register);
                     ss:=sym_stabstr_evaluate(sym,'"$$t:$1",${N_RSYM},0,0,$2',
-                        [c+def_stab_number(tprocdef(sym.owner.defowner)._class),tostr(regstabs_table[regidx])]);
+                        [c+def_stab_number(tprocdef(sym.owner.defowner).struct),tostr(regstabs_table[regidx])]);
                   end
               end;
           end

compiler/globals.pas

@@ -52,7 +52,7 @@ interface
          [m_delphi,m_all,m_class,m_objpas,m_result,m_string_pchar,
           m_pointer_2_procedure,m_autoderef,m_tp_procvar,m_initfinal,m_default_ansistring,
           m_out,m_default_para,m_duplicate_names,m_hintdirective,m_add_pointer,
-          m_property,m_default_inline,m_except];
+          m_property,m_default_inline,m_except,m_extended_records];
        fpcmodeswitches =
          [m_fpc,m_all,m_string_pchar,m_nested_comment,m_repeat_forward,
           m_cvar_support,m_initfinal,m_add_pointer,m_hintdirective,

compiler/globtype.pas

@@ -273,7 +273,8 @@ interface
          m_objectivec1,         { support interfacing with Objective-C (1.0) }
          m_objectivec2,         { support interfacing with Objective-C (2.0) }
          m_nested_procvars,     { support nested procedural variables }
-         m_non_local_goto       { support non local gotos (like iso pascal) }
+         m_non_local_goto,      { support non local gotos (like iso pascal) }
+         m_extended_records     { extended record syntax with visibility sections, methods and properties }
        );
        tmodeswitches = set of tmodeswitch;
 
@@ -393,7 +394,8 @@ interface
          'OBJECTIVEC1',
          'OBJECTIVEC2',
          'NESTEDPROCVARS',
-         'NONLOCALGOTO');
+         'NONLOCALGOTO',
+         'EXTENDEDRECORDS');
 
 
      type

compiler/htypechk.pas

@@ -66,7 +66,7 @@ interface
         FParaNode   : tnode;
         FParaLength : smallint;
         FAllowVariant : boolean;
-        procedure collect_overloads_in_class(ProcdefOverloadList:TFPObjectList);
+        procedure collect_overloads_in_struct(ProcdefOverloadList:TFPObjectList);
         procedure collect_overloads_in_units(ProcdefOverloadList:TFPObjectList; objcidcall,explicitunit: boolean);
         procedure create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit:boolean);
         function  proc_add(ps:tprocsym;pd:tprocdef;objcidcall: boolean):pcandidate;
@@ -1714,21 +1714,21 @@ implementation
       end;
 
 
-    procedure tcallcandidates.collect_overloads_in_class(ProcdefOverloadList:TFPObjectList);
+    procedure tcallcandidates.collect_overloads_in_struct(ProcdefOverloadList:TFPObjectList);
       var
         j          : integer;
         pd         : tprocdef;
         srsym      : tsym;
-        objdef     : tobjectdef;
+        structdef  : tabstractrecorddef;
         hashedid   : THashedIDString;
         hasoverload : boolean;
       begin
-        objdef:=tobjectdef(fprocsym.owner.defowner);
+        structdef:=tabstractrecorddef(fprocsym.owner.defowner);
         hashedid.id:=fprocsym.name;
         hasoverload:=false;
-        while assigned(objdef) do
+        while assigned(structdef) do
          begin
-           srsym:=tprocsym(objdef.symtable.FindWithHash(hashedid));
+           srsym:=tprocsym(structdef.symtable.FindWithHash(hashedid));
            if assigned(srsym) and
               { Delphi allows hiding a property by a procedure with the same name }
               (srsym.typ=procsym) then
@@ -1747,7 +1747,10 @@ implementation
                  break;
              end;
            { next parent }
-           objdef:=objdef.childof;
+           if (structdef.typ=objectdef) then
+             structdef:=tobjectdef(structdef).childof
+           else
+             structdef:=nil;
          end;
       end;
 
@@ -1830,7 +1833,7 @@ implementation
         hp    : pcandidate;
         pt    : tcallparanode;
         found : boolean;
-        contextobjdef : tobjectdef;
+        contextstructdef : tabstractrecorddef;
         ProcdefOverloadList : TFPObjectList;
       begin
         FCandidateProcs:=nil;
@@ -1839,8 +1842,8 @@ implementation
         ProcdefOverloadList:=TFPObjectList.Create(false);
         if not objcidcall and
            (FOperator=NOTOKEN) and
-           (FProcsym.owner.symtabletype=objectsymtable) then
-          collect_overloads_in_class(ProcdefOverloadList)
+           (FProcsym.owner.symtabletype in [objectsymtable,recordsymtable]) then
+          collect_overloads_in_struct(ProcdefOverloadList)
         else
           collect_overloads_in_units(ProcdefOverloadList,objcidcall,explicitunit);
 
@@ -1864,15 +1867,15 @@ implementation
           units. At least kylix supports it this way (PFV) }
         if assigned(FProcSymtable) and
            (
-            (FProcSymtable.symtabletype=ObjectSymtable) or
+            (FProcSymtable.symtabletype in [ObjectSymtable,recordsymtable]) or
             ((FProcSymtable.symtabletype=withsymtable) and
-             (FProcSymtable.defowner.typ=objectdef))
+             (FProcSymtable.defowner.typ in [objectdef,recorddef]))
            ) and
            (FProcSymtable.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
            FProcSymtable.defowner.owner.iscurrentunit then
-          contextobjdef:=tobjectdef(FProcSymtable.defowner)
+          contextstructdef:=tabstractrecorddef(FProcSymtable.defowner)
         else
-          contextobjdef:=current_objectdef;
+          contextstructdef:=current_structdef;
 
         { Process all found overloads }
         for j:=0 to ProcdefOverloadList.Count-1 do
@@ -1897,8 +1900,8 @@ implementation
                ) and
                (
                 ignorevisibility or
-                (pd.owner.symtabletype<>objectsymtable) or
-                is_visible_for_object(pd,contextobjdef)
+                not (pd.owner.symtabletype in [objectsymtable,recordsymtable]) or
+                is_visible_for_object(pd,contextstructdef)
                ) then
               begin
                 { don't add duplicates, only compare visible parameters for the user }

compiler/i386/cgcpu.pas

@@ -617,7 +617,7 @@ unit cgcpu;
           if (procdef.extnumber=$ffff) then
             Internalerror(200006139);
           { call/jmp  vmtoffs(%eax) ; method offs }
-          reference_reset_base(href,NR_EAX,procdef._class.vmtmethodoffset(procdef.extnumber),4);
+          reference_reset_base(href,NR_EAX,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),4);
           list.concat(taicpu.op_ref(op,S_L,href));
         end;
 
@@ -629,7 +629,7 @@ unit cgcpu;
           if (procdef.extnumber=$ffff) then
             Internalerror(200006139);
           { mov vmtoffs(%eax),%eax ; method offs }
-          reference_reset_base(href,NR_EAX,procdef._class.vmtmethodoffset(procdef.extnumber),4);
+          reference_reset_base(href,NR_EAX,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),4);
           cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_EAX);
         end;
 
@@ -641,7 +641,7 @@ unit cgcpu;
       begin
         if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
           Internalerror(200006137);
-        if not assigned(procdef._class) or
+        if not assigned(procdef.struct) or
            (procdef.procoptions*[po_classmethod, po_staticmethod,
              po_methodpointer, po_interrupt, po_iocheck]<>[]) then
           Internalerror(200006138);

compiler/m68k/cgcpu.pas

@@ -1565,7 +1565,7 @@ unit cgcpu;
           if (procdef.extnumber=$ffff) then
             Internalerror(200006139);
           { call/jmp  vmtoffs(%eax) ; method offs }
-          reference_reset_base(href,NR_R11,procdef._class.vmtmethodoffset(procdef.extnumber));
+          reference_reset_base(href,NR_R11,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber));
           if not((longint(href.offset) >= low(smallint)) and
                  (longint(href.offset) <= high(smallint))) then
             begin
@@ -1583,7 +1583,7 @@ unit cgcpu;
       begin
         if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
           Internalerror(200006137);
-        if not assigned(procdef._class) or
+        if not assigned(procdef.struct) or
            (procdef.procoptions*[po_classmethod, po_staticmethod,
              po_methodpointer, po_interrupt, po_iocheck]<>[]) then
           Internalerror(200006138);

compiler/mips/cgcpu.pas

@@ -1649,7 +1649,7 @@ procedure TCgMPSel.g_intf_wrapper(list: tasmlist; procdef: tprocdef; const label
           if (procdef.extnumber=$ffff) then
             Internalerror(200006139);
           { call/jmp  vmtoffs(%eax) ; method offs }
-          reference_reset_base(href, NR_R24, procdef._class.vmtmethodoffset(procdef.extnumber), sizeof(aint));
+          reference_reset_base(href, NR_R24, tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber), sizeof(aint));
           cg.a_load_ref_reg(list, OS_ADDR, OS_ADDR, href, NR_R24);
           list.concat(taicpu.op_reg(A_JR, NR_R24));
         end;
@@ -1659,7 +1659,7 @@ var
 begin
   if procdef.proctypeoption <> potype_none then
     Internalerror(200006137);
-  if not assigned(procdef._class) or
+  if not assigned(procdef.struct) or
     (procdef.procoptions * [po_classmethod, po_staticmethod,
     po_methodpointer, po_interrupt, po_iocheck] <> []) then
     Internalerror(200006138);

compiler/msg/errore.msg

@@ -368,7 +368,7 @@ scanner_w_illegal_warn_identifier=02087_W_Illegal identifier "$1" for $WARN dire
 #
 # Parser
 #
-# 03298 is the last used one
+# 03302 is the last used one
 #
 % \section{Parser messages}
 % This section lists all parser messages. The parser takes care of the
@@ -1310,7 +1310,6 @@ parser_e_no_paras_for_class_constructor=03290_E_Class constructors can't have pa
 parser_e_no_paras_for_class_destructor=03291_E_Class destructors can't have parameters
 % You are declaring a class destructor with a parameter list. Class destructor methods
 % cannot have parameters.
-
 parser_f_modeswitch_objc_required=03292_F_This construct requires the \{\$modeswitch objectivec1\} mode switch to be active
 % Objective-Pascal constructs are not supported when \{\$modeswitch ObjectiveC1\}
 % is not active.
@@ -1352,6 +1351,15 @@ parser_e_forward_protocol_declaration_must_be_resolved=03298_E_Forward declarati
 % \end{verbatim}
 % where \var{MyProtocol} is declared but not defined.
 % \end{description}
+parser_e_no_record_published=03299_E_Record types cannot have published sections
+% Published sections can be used only inside classes.
+parser_e_no_destructor_in_records=03300_E_Destructors aren't allowed in records
+% Destructor declarations aren't allowed in records.
+parser_e_class_methods_only_static_in_records=03301_E_Class methods must be static in records
+% Class methods declarations aren't allowed in records without static modifier.
+% Records have no inheritance and therefore non static class methods have no sence for them.
+parser_e_no_constructor_in_records=03302_E_Constructors aren't allowed in records
+% Constructor declarations aren't allowed in records.
 #
 # Type Checking
 #

compiler/msgidx.inc

@@ -387,6 +387,10 @@ const
   parser_e_no_procvarnested_const=03296;
   parser_f_no_generic_inside_generic=03297;
   parser_e_forward_protocol_declaration_must_be_resolved=03298;
+  parser_e_no_record_published=03299;
+  parser_e_no_destructor_in_records=03300;
+  parser_e_class_methods_only_static_in_records=03301;
+  parser_e_no_constructor_in_records=03302;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -872,9 +876,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 58009;
+  MsgTxtSize = 58202;
 
   MsgIdxMax : array[1..20] of longint=(
-    24,88,299,97,82,54,111,22,202,63,
+    24,88,303,97,82,54,111,22,202,63,
     49,20,1,1,1,1,1,1,1,1
   );

compiler/ncal.pas

@@ -1671,7 +1671,8 @@ implementation
             begin
               if (procdefinition.typ<>procdef) then
                 internalerror(200305062);
-              if (oo_has_vmt in tprocdef(procdefinition)._class.objectoptions) then
+              if (tprocdef(procdefinition).struct.typ=objectdef) and
+                 (oo_has_vmt in tprocdef(procdefinition).struct.objectoptions) then
                 begin
                   { we only need the vmt, loading self is not required and there is no
                     need to check for typen, because that will always get the
@@ -2871,7 +2872,7 @@ implementation
               error and to prevent users from generating non-working code
               when they expect to clone the current instance, see bug 3662 (PFV) }
               if (procdefinition.proctypeoption=potype_constructor) and
-                 is_class(tprocdef(procdefinition)._class) and
+                 is_class(tprocdef(procdefinition).struct) and
                  assigned(methodpointer) and
                  (nf_is_self in methodpointer.flags) then
                 resultdef:=voidtype

compiler/ncgcal.pas

@@ -688,12 +688,12 @@ implementation
                 (methodpointer.nodetype<>typen) and
                 (not assigned(current_procinfo) or
                  wpoinfomanager.symbol_live(current_procinfo.procdef.mangledname)) then
-               tprocdef(procdefinition)._class.register_vmt_call(tprocdef(procdefinition).extnumber);
+               tobjectdef(tprocdef(procdefinition).struct).register_vmt_call(tprocdef(procdefinition).extnumber);
 {$ifdef vtentry}
              if not is_interface(tprocdef(procdefinition)._class) then
                begin
                  inc(current_asmdata.NextVTEntryNr);
-                 current_asmdata.CurrAsmList.Concat(tai_symbol.CreateName('VTREF'+tostr(current_asmdata.NextVTEntryNr)+'_'+tprocdef(procdefinition)._class.vmt_mangledname+'$$'+tostr(vmtoffset div sizeof(pint)),AT_FUNCTION,0));
+                 current_asmdata.CurrAsmList.Concat(tai_symbol.CreateName('VTREF'+tostr(current_asmdata.NextVTEntryNr)+'_'+tprocdef(procdefinition).struct.vmt_mangledname+'$$'+tostr(vmtoffset div sizeof(pint)),AT_FUNCTION,0));
                end;
 {$endif vtentry}
 
@@ -725,16 +725,16 @@ implementation
                    end;
 
                  { test validity of VMT }
-                 if not(is_interface(tprocdef(procdefinition)._class)) and
-                    not(is_cppclass(tprocdef(procdefinition)._class)) then
-                   cg.g_maybe_testvmt(current_asmdata.CurrAsmList,vmtreg,tprocdef(procdefinition)._class);
+                 if not(is_interface(tprocdef(procdefinition).struct)) and
+                    not(is_cppclass(tprocdef(procdefinition).struct)) then
+                   cg.g_maybe_testvmt(current_asmdata.CurrAsmList,vmtreg,tobjectdef(tprocdef(procdefinition).struct));
 
                  { Call through VMT, generate a VTREF symbol to notify the linker }
-                 vmtoffset:=tprocdef(procdefinition)._class.vmtmethodoffset(tprocdef(procdefinition).extnumber);
+                 vmtoffset:=tobjectdef(tprocdef(procdefinition).struct).vmtmethodoffset(tprocdef(procdefinition).extnumber);
                  { register call for WPO }
                  if (not assigned(current_procinfo) or
                      wpoinfomanager.symbol_live(current_procinfo.procdef.mangledname)) then
-                   tprocdef(procdefinition)._class.register_vmt_call(tprocdef(procdefinition).extnumber);
+                   tobjectdef(tprocdef(procdefinition).struct).register_vmt_call(tprocdef(procdefinition).extnumber);
 {$ifndef x86}
                  pvreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_ADDR);
 {$endif not x86}

compiler/ncgld.pas

@@ -500,9 +500,9 @@ implementation
                        begin
                          if (not assigned(current_procinfo) or
                              wpoinfomanager.symbol_live(current_procinfo.procdef.mangledname)) then
-                           procdef._class.register_vmt_call(procdef.extnumber);
+                           tobjectdef(procdef.struct).register_vmt_call(procdef.extnumber);
             {$ifdef vtentry}
-                         if not is_interface(procdef._class) then
+                         if not is_interface(procdef.struct) then
                            begin
                              inc(current_asmdata.NextVTEntryNr);
                              current_asmdata.CurrAsmList.Concat(tai_symbol.CreateName('VTREF'+tostr(current_asmdata.NextVTEntryNr)+'_'+procdef._class.vmt_mangledname+'$$'+tostr(vmtoffset div sizeof(pint)),AT_FUNCTION,0));
@@ -517,7 +517,7 @@ implementation
                              cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,href,hregister);
                            end;
                          { load method address }
-                         reference_reset_base(href,hregister,procdef._class.vmtmethodoffset(procdef.extnumber),sizeof(pint));
+                         reference_reset_base(href,hregister,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
                          hregister:=cg.getaddressregister(current_asmdata.CurrAsmList);
                          cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,href,hregister);
                          { ... and store it }

compiler/ncgrtti.pas

@@ -318,9 +318,9 @@ implementation
                   begin
                      { virtual method, write vmt offset }
                      current_asmdata.asmlists[al_rtti].concat(Tai_const.create(aitconst_ptr,
-                       tprocdef(propaccesslist.procdef)._class.vmtmethodoffset(tprocdef(propaccesslist.procdef).extnumber)));
+                       tobjectdef(tprocdef(propaccesslist.procdef).struct).vmtmethodoffset(tprocdef(propaccesslist.procdef).extnumber)));
                      { register for wpo }
-                     tprocdef(propaccesslist.procdef)._class.register_vmt_call(tprocdef(propaccesslist.procdef).extnumber);
+                     tobjectdef(tprocdef(propaccesslist.procdef).struct).register_vmt_call(tprocdef(propaccesslist.procdef).extnumber);
                      {$ifdef vtentry}
                      { not sure if we can insert those vtentry symbols safely here }
                      {$error register methods used for published properties}

compiler/nflw.pas

@@ -383,7 +383,7 @@ implementation
                  ccallparanode.create(caddrnode.create(ctemprefnode.create(state)),nil)
                )
              );
-         sym:=search_class_member(objc_fastenumeration,'COUNTBYENUMERATINGWITHSTATE_OBJECTS_COUNT');
+         sym:=search_struct_member(objc_fastenumeration,'COUNTBYENUMERATINGWITHSTATE_OBJECTS_COUNT');
          if not assigned(sym) or
             (sym.typ<>procsym) then
            internalerror(2010061901);

compiler/nld.pas

@@ -301,17 +301,17 @@ implementation
                  definition }
                if vo_is_self in tabstractvarsym(symtableentry).varoptions then
                  begin
-                   resultdef:=tprocdef(symtableentry.owner.defowner)._class;
+                   resultdef:=tprocdef(symtableentry.owner.defowner).struct;
                    if (po_classmethod in tprocdef(symtableentry.owner.defowner).procoptions) or
                       (po_staticmethod in tprocdef(symtableentry.owner.defowner).procoptions) then
                      resultdef:=tclassrefdef.create(resultdef)
-                   else if is_object(resultdef) and
+                   else if (is_object(resultdef) or is_record(resultdef)) and
                            (nf_load_self_pointer in flags) then
                      resultdef:=tpointerdef.create(resultdef);
                  end
                else if vo_is_vmt in tabstractvarsym(symtableentry).varoptions then
                  begin
-                   resultdef:=tprocdef(symtableentry.owner.defowner)._class;
+                   resultdef:=tprocdef(symtableentry.owner.defowner).struct;
                    resultdef:=tclassrefdef.create(resultdef);
                  end
                else

compiler/nmem.pas

@@ -160,7 +160,8 @@ implementation
         case left.resultdef.typ of
           classrefdef :
             resultdef:=left.resultdef;
-          objectdef :
+          objectdef,
+          recorddef:
             { access to the classtype while specializing? }
             if (df_generic in left.resultdef.defoptions) then
               begin
@@ -202,7 +203,7 @@ implementation
              if is_objcclass(left.resultdef) and
                 (left.nodetype<>typen) then
                begin
-                 vs:=search_class_member(tobjectdef(left.resultdef),'ISA');
+                 vs:=search_struct_member(tobjectdef(left.resultdef),'ISA');
                  if not assigned(vs) or
                     (tsym(vs).typ<>fieldvarsym) then
                    internalerror(2009092502);

compiler/nobj.pas

@@ -536,7 +536,7 @@ implementation
                 { Add procdef to the implemented interface }
                 if assigned(implprocdef) then
                   begin
-                    if (implprocdef._class.objecttype<>odt_objcclass) then
+                    if (tobjectdef(implprocdef.struct).objecttype<>odt_objcclass) then
                       ImplIntf.AddImplProc(implprocdef)
                     else
                       begin
@@ -1345,7 +1345,7 @@ implementation
           etVirtualMethodResult, etVirtualMethodClass:
             begin
               pd := tprocdef(tpropertysym(AImplIntf.ImplementsGetter).propaccesslist[palt_read].procdef);
-              current_asmdata.asmlists[al_globals].concat(Tai_const.Create_pint(pd._class.vmtmethodoffset(pd.extnumber)));
+              current_asmdata.asmlists[al_globals].concat(Tai_const.Create_pint(tobjectdef(pd.struct).vmtmethodoffset(pd.extnumber)));
             end;
           else
             internalerror(200802162);

compiler/nutils.pas

@@ -534,9 +534,9 @@ implementation
         result:=internalstatements(newstatement);
 
         { call fail helper and exit normal }
-        if is_class(current_objectdef) then
+        if is_class(current_structdef) then
           begin
-            srsym:=search_class_member(current_objectdef,'FREEINSTANCE');
+            srsym:=search_struct_member(current_objectdef,'FREEINSTANCE');
             if assigned(srsym) and
                (srsym.typ=procsym) then
               begin
@@ -556,7 +556,7 @@ implementation
               internalerror(200305108);
           end
         else
-          if is_object(current_objectdef) then
+          if is_object(current_structdef) then
             begin
               { parameter 3 : vmt_offset }
               { parameter 2 : pointer to vmt }

compiler/pdecl.pas

@@ -36,10 +36,10 @@ interface
     function  readconstant(const orgname:string;const filepos:tfileposinfo):tconstsym;
 
     procedure const_dec;
-    procedure consts_dec(in_class: boolean);
+    procedure consts_dec(in_structure: boolean);
     procedure label_dec;
     procedure type_dec;
-    procedure types_dec(in_class: boolean);
+    procedure types_dec(in_structure: boolean);
     procedure var_dec;
     procedure threadvar_dec;
     procedure property_dec(is_classpropery: boolean);
@@ -85,7 +85,7 @@ implementation
         if orgname='' then
          internalerror(9584582);
         hp:=nil;
-        p:=comp_expr(true);
+        p:=comp_expr(true,false);
         storetokenpos:=current_tokenpos;
         current_tokenpos:=filepos;
         case p.nodetype of
@@ -161,7 +161,7 @@ implementation
         consts_dec(false);
       end;
 
-    procedure consts_dec(in_class: boolean);
+    procedure consts_dec(in_structure: boolean);
       var
          orgname : TIDString;
          hdef : tdef;
@@ -254,7 +254,7 @@ implementation
                         tclist:=current_asmdata.asmlists[al_rotypedconsts]
                       else
                         tclist:=current_asmdata.asmlists[al_typedconsts];
-                      read_typed_const(tclist,tstaticvarsym(sym),in_class);
+                      read_typed_const(tclist,tstaticvarsym(sym),in_structure);
                     end;
                 end;
 
@@ -262,7 +262,7 @@ implementation
                 { generate an error }
                 consume(_EQUAL);
            end;
-         until (token<>_ID)or(in_class and (idtoken in [_PRIVATE,_PROTECTED,_PUBLIC,_PUBLISHED,_STRICT]));
+         until (token<>_ID)or(in_structure and (idtoken in [_PRIVATE,_PROTECTED,_PUBLIC,_PUBLISHED,_STRICT]));
          block_type:=old_block_type;
       end;
 
@@ -309,7 +309,7 @@ implementation
       end;
 
 
-    procedure types_dec(in_class: boolean);
+    procedure types_dec(in_structure: boolean);
 
       procedure get_cpp_class_external_status(od: tobjectdef);
         var
@@ -669,7 +669,7 @@ implementation
              end;
            if assigned(generictypelist) then
              generictypelist.free;
-         until (token<>_ID)or(in_class and (idtoken in [_PRIVATE,_PROTECTED,_PUBLIC,_PUBLISHED,_STRICT]));
+         until (token<>_ID)or(in_structure and (idtoken in [_PRIVATE,_PROTECTED,_PUBLIC,_PUBLISHED,_STRICT]));
          { resolve type block forward declarations and restore a unit
            container for them }
          resolve_forward_types;
@@ -748,7 +748,7 @@ implementation
              _EQUAL:
                 begin
                    consume(_EQUAL);
-                   p:=comp_expr(true);
+                   p:=comp_expr(true,false);
                    storetokenpos:=current_tokenpos;
                    current_tokenpos:=filepos;
                    sym:=nil;

compiler/pdecobj.pas

@@ -32,6 +32,12 @@ interface
     { parses a object declaration }
     function object_dec(objecttype:tobjecttyp;const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef) : tobjectdef;
 
+    function class_constructor_head:tprocdef;
+    function class_destructor_head:tprocdef;
+    function constructor_head:tprocdef;
+    function destructor_head:tprocdef;
+    procedure struct_property_dec(is_classproperty:boolean);
+
 implementation
 
     uses
@@ -57,7 +63,7 @@ implementation
         result:=nil;
         consume(_CONSTRUCTOR);
         { must be at same level as in implementation }
-        parse_proc_head(current_objectdef,potype_class_constructor,pd);
+        parse_proc_head(current_structdef,potype_class_constructor,pd);
         if not assigned(pd) then
           begin
             consume(_SEMICOLON);
@@ -67,7 +73,7 @@ implementation
         if (pd.maxparacount>0) then
           Message(parser_e_no_paras_for_class_constructor);
         consume(_SEMICOLON);
-        include(current_objectdef.objectoptions,oo_has_class_constructor);
+        include(current_structdef.objectoptions,oo_has_class_constructor);
         current_module.flags:=current_module.flags or uf_classinits;
         { no return value }
         pd.returndef:=voidtype;
@@ -81,7 +87,7 @@ implementation
         result:=nil;
         consume(_CONSTRUCTOR);
         { must be at same level as in implementation }
-        parse_proc_head(current_objectdef,potype_constructor,pd);
+        parse_proc_head(current_structdef,potype_constructor,pd);
         if not assigned(pd) then
           begin
             consume(_SEMICOLON);
@@ -91,11 +97,11 @@ implementation
            (pd.procsym.name<>'INIT') then
           Message(parser_e_constructorname_must_be_init);
         consume(_SEMICOLON);
-        include(current_objectdef.objectoptions,oo_has_constructor);
-        { Set return type, class constructors return the
+        include(current_structdef.objectoptions,oo_has_constructor);
+        { Set return type, class and record constructors return the
           created instance, object constructors return boolean }
-        if is_class(pd._class) then
-          pd.returndef:=pd._class
+        if is_class(pd.struct) or is_record(pd.struct) then
+          pd.returndef:=pd.struct
         else
 {$ifdef CPU64bitaddr}
           pd.returndef:=bool64type;
@@ -106,22 +112,22 @@ implementation
       end;
 
 
-    procedure property_dec(is_classproperty:boolean);
+    procedure struct_property_dec(is_classproperty:boolean);
       var
         p : tpropertysym;
       begin
-        { check for a class }
-        if not((is_class_or_interface_or_dispinterface(current_objectdef)) or
-           (not(m_tp7 in current_settings.modeswitches) and (is_object(current_objectdef)))) then
+        { check for a class or record }
+        if not((is_class_or_interface_or_dispinterface(current_structdef) or is_record(current_structdef)) or
+           (not(m_tp7 in current_settings.modeswitches) and (is_object(current_structdef)))) then
           Message(parser_e_syntax_error);
         consume(_PROPERTY);
-        p:=read_property_dec(is_classproperty, current_objectdef);
+        p:=read_property_dec(is_classproperty,current_structdef);
         consume(_SEMICOLON);
         if try_to_consume(_DEFAULT) then
           begin
-            if oo_has_default_property in current_objectdef.objectoptions then
+            if oo_has_default_property in current_structdef.objectoptions then
               message(parser_e_only_one_default_property);
-            include(current_objectdef.objectoptions,oo_has_default_property);
+            include(current_structdef.objectoptions,oo_has_default_property);
             include(p.propoptions,ppo_defaultproperty);
             if not(ppo_hasparameters in p.propoptions) then
               message(parser_e_property_need_paras);
@@ -139,11 +145,11 @@ implementation
             begin
               if pattern='CURRENT' then
               begin
-                if oo_has_enumerator_current in current_objectdef.objectoptions then
+                if oo_has_enumerator_current in current_structdef.objectoptions then
                   message(parser_e_only_one_enumerator_current);
                 if not p.propaccesslist[palt_read].empty then
                 begin
-                  include(current_objectdef.objectoptions,oo_has_enumerator_current);
+                  include(current_structdef.objectoptions,oo_has_enumerator_current);
                   include(p.propoptions,ppo_enumerator_current);
                 end
                 else
@@ -170,7 +176,7 @@ implementation
       begin
         result:=nil;
         consume(_DESTRUCTOR);
-        parse_proc_head(current_objectdef,potype_class_destructor,pd);
+        parse_proc_head(current_structdef,potype_class_destructor,pd);
         if not assigned(pd) then
           begin
             consume(_SEMICOLON);
@@ -180,7 +186,7 @@ implementation
         if (pd.maxparacount>0) then
           Message(parser_e_no_paras_for_class_destructor);
         consume(_SEMICOLON);
-        include(current_objectdef.objectoptions,oo_has_class_destructor);
+        include(current_structdef.objectoptions,oo_has_class_destructor);
         current_module.flags:=current_module.flags or uf_classinits;
         { no return value }
         pd.returndef:=voidtype;
@@ -193,7 +199,7 @@ implementation
       begin
         result:=nil;
         consume(_DESTRUCTOR);
-        parse_proc_head(current_objectdef,potype_destructor,pd);
+        parse_proc_head(current_structdef,potype_destructor,pd);
         if not assigned(pd) then
           begin
             consume(_SEMICOLON);
@@ -207,7 +213,7 @@ implementation
            (m_fpc in current_settings.modeswitches) then
           Message(parser_e_no_paras_for_destructor);
         consume(_SEMICOLON);
-        include(current_objectdef.objectoptions,oo_has_destructor);
+        include(current_structdef.objectoptions,oo_has_destructor);
         { no return value }
         pd.returndef:=voidtype;
         result:=pd;
@@ -319,7 +325,7 @@ implementation
         p : tnode;
         valid : boolean;
       begin
-        p:=comp_expr(true);
+        p:=comp_expr(true,false);
         if p.nodetype=stringconstn then
           begin
             stringdispose(current_objectdef.iidstr);
@@ -549,7 +555,7 @@ implementation
 
       procedure chkobjc(pd: tprocdef);
         begin
-          if is_objc_class_or_protocol(pd._class) then
+          if is_objc_class_or_protocol(pd.struct) then
             begin
               include(pd.procoptions,po_objc);
             end;
@@ -764,7 +770,7 @@ implementation
               end;
             _PROPERTY :
               begin
-                property_dec(is_classdef);
+                struct_property_dec(is_classdef);
                 fields_allowed:=false;
                 is_classdef:=false;
               end;
@@ -795,7 +801,7 @@ implementation
 
                 oldparse_only:=parse_only;
                 parse_only:=true;
-                pd:=parse_proc_dec(is_classdef, current_objectdef);
+                pd:=parse_proc_dec(is_classdef,current_objectdef);
 
                 { this is for error recovery as well as forward }
                 { interface mappings, i.e. mapping to a method  }
@@ -805,9 +811,9 @@ implementation
                     parse_object_proc_directives(pd);
 
                     { check if dispid is set }
-                    if is_dispinterface(pd._class) and not (po_dispid in pd.procoptions) then
+                    if is_dispinterface(pd.struct) and not (po_dispid in pd.procoptions) then
                       begin
-                        pd.dispid:=pd._class.get_next_dispid;
+                        pd.dispid:=tobjectdef(pd.struct).get_next_dispid;
                         include(pd.procoptions, po_dispid);
                       end;
 

compiler/pdecsub.pas

@@ -31,13 +31,15 @@ interface
     type
       tpdflag=(
         pd_body,         { directive needs a body }
-        pd_implemen,     { directive can be used implementation section }
-        pd_interface,    { directive can be used interface section }
-        pd_object,       { directive can be used object declaration }
-        pd_procvar,      { directive can be used procvar declaration }
-        pd_notobject,    { directive can not be used object declaration }
-        pd_notobjintf,   { directive can not be used interface declaration }
-        pd_notprocvar,   { directive can not be used procvar declaration }
+        pd_implemen,     { directive can be used in implementation section }
+        pd_interface,    { directive can be used in interface section }
+        pd_object,       { directive can be used with object declaration }
+        pd_record,       { directive can be used with record declaration }
+        pd_procvar,      { directive can be used with procvar declaration }
+        pd_notobject,    { directive can not be used with object declaration }
+        pd_notrecord,    { directive can not be used with record declaration }
+        pd_notobjintf,   { directive can not be used with interface declaration }
+        pd_notprocvar,   { directive can not be used with procvar declaration }
         pd_dispinterface,{ directive can be used with dispinterface methods }
         pd_cppobject,    { directive can be used with cppclass }
         pd_objcclass,    { directive can be used with objcclass }
@@ -59,16 +61,17 @@ interface
     procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags);
     procedure parse_var_proc_directives(sym:tsym);
     procedure parse_object_proc_directives(pd:tabstractprocdef);
-    function  parse_proc_head(aclass:tobjectdef;potype:tproctypeoption;var pd:tprocdef):boolean;
-    function  parse_proc_dec(isclassmethod:boolean; aclass:tobjectdef):tprocdef;
+    procedure parse_record_proc_directives(pd:tabstractprocdef);
+    function  parse_proc_head(astruct:tabstractrecorddef;potype:tproctypeoption;var pd:tprocdef):boolean;
+    function  parse_proc_dec(isclassmethod:boolean;astruct:tabstractrecorddef):tprocdef;
 
     { helper functions - they insert nested objects hierarcy to the symtablestack
       with object hierarchy
     }
-    function push_child_hierarcy(obj:tobjectdef):integer;
-    function pop_child_hierarchy(obj:tobjectdef):integer;
-    function push_nested_hierarchy(obj:tobjectdef):integer;
-    function pop_nested_hierarchy(obj:tobjectdef):integer;
+    function push_child_hierarcy(obj:tabstractrecorddef):integer;
+    function pop_child_hierarchy(obj:tabstractrecorddef):integer;
+    function push_nested_hierarchy(obj:tabstractrecorddef):integer;
+    function pop_nested_hierarchy(obj:tabstractrecorddef):integer;
 
 implementation
 
@@ -97,15 +100,21 @@ implementation
         Declaring it as string here results in an error when compiling (PFV) }
       current_procinfo = 'error';
 
-    function push_child_hierarcy(obj:tobjectdef):integer;
+    function push_child_hierarcy(obj:tabstractrecorddef):integer;
       var
         _class,hp : tobjectdef;
       begin
+        if obj.typ=recorddef then
+          begin
+            symtablestack.push(obj.symtable);
+            result:=1;
+            exit;
+          end;
         result:=0;
         { insert class hierarchy in the reverse order }
         hp:=nil;
         repeat
-          _class:=obj;
+          _class:=tobjectdef(obj);
           while _class.childof<>hp do
             _class:=_class.childof;
           hp:=_class;
@@ -114,20 +123,26 @@ implementation
         until hp=obj;
       end;
 
-    function push_nested_hierarchy(obj:tobjectdef):integer;
+    function push_nested_hierarchy(obj:tabstractrecorddef):integer;
       begin
         result:=0;
-        if obj.owner.symtabletype=ObjectSymtable then
-          inc(result,push_nested_hierarchy(tobjectdef(obj.owner.defowner)));
+        if obj.owner.symtabletype in [ObjectSymtable,recordsymtable] then
+          inc(result,push_nested_hierarchy(tabstractrecorddef(obj.owner.defowner)));
         inc(result,push_child_hierarcy(obj));
       end;
 
-    function pop_child_hierarchy(obj:tobjectdef):integer;
+    function pop_child_hierarchy(obj:tabstractrecorddef):integer;
       var
         _class : tobjectdef;
       begin
+        if obj.typ=recorddef then
+          begin
+            symtablestack.pop(obj.symtable);
+            result:=1;
+            exit;
+          end;
         result:=0;
-        _class:=obj;
+        _class:=tobjectdef(obj);
         while assigned(_class) do
           begin
             symtablestack.pop(_class.symtable);
@@ -136,11 +151,11 @@ implementation
           end;
       end;
 
-    function pop_nested_hierarchy(obj:tobjectdef):integer;
+    function pop_nested_hierarchy(obj:tabstractrecorddef):integer;
       begin
         result:=pop_child_hierarchy(obj);
-        if obj.owner.symtabletype=ObjectSymtable then
-          inc(result,pop_nested_hierarchy(tobjectdef(obj.owner.defowner)));
+        if obj.owner.symtabletype in [ObjectSymtable,recordsymtable] then
+          inc(result,pop_nested_hierarchy(tabstractrecorddef(obj.owner.defowner)));
       end;
 
     procedure insert_funcret_para(pd:tabstractprocdef);
@@ -234,7 +249,7 @@ implementation
         sl       : tpropaccesslist;
       begin
         if (pd.typ=procdef) and
-           is_objc_class_or_protocol(tprocdef(pd)._class) and
+           is_objc_class_or_protocol(tprocdef(pd).struct) and
            (pd.parast.symtablelevel=normal_function_level) then
           begin
             { insert Objective-C self and selector parameters }
@@ -251,7 +266,7 @@ implementation
               { compatible with what gcc does }
               hdef:=objc_idtype
             else
-              hdef:=tprocdef(pd)._class;
+              hdef:=tprocdef(pd).struct;
 
             vs:=tparavarsym.create('$self',paranr_objc_self,vs_value,hdef,[vo_is_self,vo_is_hidden_para]);
             pd.parast.insert(vs);
@@ -266,7 +281,7 @@ implementation
         else
           begin
              if (pd.typ=procdef) and
-                assigned(tprocdef(pd)._class) and
+                assigned(tprocdef(pd).struct) and
                 (pd.parast.symtablelevel=normal_function_level) then
               begin
                 { static class methods have no hidden self/vmt pointer }
@@ -277,7 +292,8 @@ implementation
                 current_tokenpos:=tprocdef(pd).fileinfo;
 
                 { Generate VMT variable for constructor/destructor }
-                if (pd.proctypeoption in [potype_constructor,potype_destructor]) and not(is_cppclass(tprocdef(pd)._class)) then
+                if (pd.proctypeoption in [potype_constructor,potype_destructor]) and
+                   not(is_cppclass(tprocdef(pd).struct) or is_record(tprocdef(pd).struct)) then
                  begin
                    { can't use classrefdef as type because inheriting
                      will then always file because of a type mismatch }
@@ -291,12 +307,12 @@ implementation
                 vsp:=vs_value;
                 if (po_staticmethod in pd.procoptions) or
                    (po_classmethod in pd.procoptions) then
-                  hdef:=tclassrefdef.create(tprocdef(pd)._class)
+                  hdef:=tclassrefdef.create(tprocdef(pd).struct)
                 else
                   begin
-                    if is_object(tprocdef(pd)._class) then
+                    if is_object(tprocdef(pd).struct) or is_record(tprocdef(pd).struct) then
                       vsp:=vs_var;
-                    hdef:=tprocdef(pd)._class;
+                    hdef:=tprocdef(pd).struct;
                   end;
                 vs:=tparavarsym.create('$self',paranr_self,vsp,hdef,[vo_is_self,vo_is_hidden_para]);
                 pd.parast.insert(vs);
@@ -397,7 +413,7 @@ implementation
                     MessagePos(fileinfo,parser_w_cdecl_no_openstring);
                  if not(po_external in pd.procoptions) and
                     (pd.typ<>procvardef) and
-                    not is_objc_class_or_protocol(tprocdef(pd)._class) then
+                    not is_objc_class_or_protocol(tprocdef(pd).struct) then
                    if is_array_of_const(vardef) then
                      MessagePos(fileinfo,parser_e_varargs_need_cdecl_and_external)
                    else
@@ -720,7 +736,7 @@ implementation
             CGMessage(cg_e_file_must_call_by_reference);
 
           { Dispinterfaces are restricted to using only automatable types }
-          if (pd.typ=procdef) and is_dispinterface(tprocdef(pd)._class) and
+          if (pd.typ=procdef) and is_dispinterface(tprocdef(pd).struct) and
              not is_automatable(hdef) then
             Message1(type_e_not_automatable,hdef.typename);
 
@@ -772,7 +788,7 @@ implementation
       end;
 
 
-    function parse_proc_head(aclass:tobjectdef;potype:tproctypeoption;var pd:tprocdef):boolean;
+    function parse_proc_head(astruct:tabstractrecorddef;potype:tproctypeoption;var pd:tprocdef):boolean;
       var
         hs       : string;
         orgsp,sp : TIDString;
@@ -788,7 +804,7 @@ implementation
         popclass : integer;
         ImplIntf : TImplementedInterface;
         old_parse_generic : boolean;
-        old_current_objectdef,
+        old_current_structdef: tabstractrecorddef;
         old_current_genericdef,
         old_current_specializedef : tobjectdef;
       begin
@@ -813,9 +829,10 @@ implementation
           end;
 
         { examine interface map: function/procedure iname.functionname=locfuncname }
-        if assigned(aclass) and
-           assigned(aclass.ImplementedInterfaces) and
-           (aclass.ImplementedInterfaces.count>0) and
+        if assigned(astruct) and
+           (astruct.typ=objectdef) and
+           assigned(tobjectdef(astruct).ImplementedInterfaces) and
+           (tobjectdef(astruct).ImplementedInterfaces.count>0) and
            try_to_consume(_POINT) then
          begin
            storepos:=current_tokenpos;
@@ -832,7 +849,7 @@ implementation
            ImplIntf:=nil;
            if (srsym.typ=typesym) and
               (ttypesym(srsym).typedef.typ=objectdef) then
-             ImplIntf:=aclass.find_implemented_interface(tobjectdef(ttypesym(srsym).typedef));
+             ImplIntf:=tobjectdef(astruct).find_implemented_interface(tobjectdef(ttypesym(srsym).typedef));
            if ImplIntf=nil then
              Message(parser_e_interface_id_expected);
            consume(_ID);
@@ -848,14 +865,14 @@ implementation
          end;
 
         { method  ? }
-        if not assigned(aclass) and
+        if not assigned(astruct) and
            (potype<>potype_operator) and
            (symtablestack.top.symtablelevel=main_program_level) and
            try_to_consume(_POINT) then
          begin
            repeat
              searchagain:=false;
-             if not assigned(aclass) then
+             if not assigned(astruct) then
                begin
                  { search for object name }
                  storepos:=current_tokenpos;
@@ -875,19 +892,19 @@ implementation
              consume(_ID);
              { qualifier is class name ? }
              if (srsym.typ=typesym) and
-                (ttypesym(srsym).typedef.typ=objectdef) then
+                (ttypesym(srsym).typedef.typ in [objectdef,recorddef]) then
               begin
-                aclass:=tobjectdef(ttypesym(srsym).typedef);
+                astruct:=tabstractrecorddef(ttypesym(srsym).typedef);
                 if (token<>_POINT) and (potype in [potype_class_constructor,potype_class_destructor]) then
                   sp := lower(sp);
-                srsym:=tsym(aclass.symtable.Find(sp));
+                srsym:=tsym(astruct.symtable.Find(sp));
                 if assigned(srsym) then
                  begin
                    if srsym.typ=procsym then
                      aprocsym:=tprocsym(srsym)
                    else
                    if (srsym.typ=typesym) and
-                      (ttypesym(srsym).typedef.typ=objectdef) then
+                      (ttypesym(srsym).typedef.typ in [objectdef,recorddef]) then
                      begin
                        searchagain:=true;
                        consume(_POINT);
@@ -908,7 +925,7 @@ implementation
                  begin
                    Message(parser_e_methode_id_expected);
                    { recover by making it a normal procedure instead of method }
-                   aclass:=nil;
+                   astruct:=nil;
                  end;
               end
              else
@@ -1001,27 +1018,27 @@ implementation
             checkstack:=checkstack^.next;
           end;
         pd:=tprocdef.create(st.symtablelevel+1);
-        pd._class:=aclass;
+        pd.struct:=astruct;
         pd.procsym:=aprocsym;
         pd.proctypeoption:=potype;
 
         { methods inherit df_generic or df_specialization from the objectdef }
-        if assigned(pd._class) and
+        if assigned(pd.struct) and
            (pd.parast.symtablelevel=normal_function_level) then
           begin
-            if (df_generic in pd._class.defoptions) then
+            if (df_generic in pd.struct.defoptions) then
               begin
                 include(pd.defoptions,df_generic);
                 parse_generic:=true;
               end;
-            if (df_specialization in pd._class.defoptions) then
+            if (df_specialization in pd.struct.defoptions) then
               begin
                 include(pd.defoptions,df_specialization);
                 { Find corresponding genericdef, we need it later to
                   replay the tokens to generate the body }
-                if not assigned(pd._class.genericdef) then
+                if not assigned(pd.struct.genericdef) then
                   internalerror(200512113);
-                genericst:=pd._class.genericdef.GetSymtable(gs_record);
+                genericst:=pd.struct.genericdef.GetSymtable(gs_record);
                 if not assigned(genericst) then
                   internalerror(200512114);
                 { We are parsing the same objectdef, the def index numbers
@@ -1034,9 +1051,9 @@ implementation
           end;
 
         { methods need to be exported }
-        if assigned(aclass) and
+        if assigned(astruct) and
            (
-            (symtablestack.top.symtabletype=ObjectSymtable) or
+            (symtablestack.top.symtabletype in [ObjectSymtable,recordsymtable]) or
             (symtablestack.top.symtablelevel=main_program_level)
            ) then
           include(pd.procoptions,po_global);
@@ -1052,19 +1069,19 @@ implementation
           begin
             { Add ObjectSymtable to be able to find nested type definitions }
             popclass:=0;
-            if assigned(pd._class) and
+            if assigned(pd.struct) and
                (pd.parast.symtablelevel=normal_function_level) and
-               (symtablestack.top.symtabletype<>ObjectSymtable) then
+               not(symtablestack.top.symtabletype in [ObjectSymtable,recordsymtable]) then
               begin
-                popclass:=push_nested_hierarchy(pd._class);
-                old_current_objectdef:=current_objectdef;
+                popclass:=push_nested_hierarchy(pd.struct);
+                old_current_structdef:=current_structdef;
                 old_current_genericdef:=current_genericdef;
                 old_current_specializedef:=current_specializedef;
-                current_objectdef:=pd._class;
-                if assigned(current_objectdef) and (df_generic in current_objectdef.defoptions) then
-                  current_genericdef:=current_objectdef;
-                if assigned(current_objectdef) and (df_specialization in current_objectdef.defoptions) then
-                  current_specializedef:=current_objectdef;
+                current_structdef:=pd.struct;
+                if assigned(current_structdef) and (df_generic in current_structdef.defoptions) then
+                  current_genericdef:=tobjectdef(current_structdef);
+                if assigned(current_structdef) and (df_specialization in current_structdef.defoptions) then
+                  current_specializedef:=tobjectdef(current_structdef);
               end;
             { Add parameter symtable }
             if pd.parast.symtabletype<>staticsymtable then
@@ -1074,10 +1091,10 @@ implementation
               symtablestack.pop(pd.parast);
             if popclass>0 then
               begin
-                current_objectdef:=old_current_objectdef;
+                current_structdef:=old_current_structdef;
                 current_genericdef:=old_current_genericdef;
                 current_specializedef:=old_current_specializedef;
-                dec(popclass,pop_nested_hierarchy(pd._class));
+                dec(popclass,pop_nested_hierarchy(pd.struct));
                 if popclass<>0 then
                   internalerror(201011260); // 11 nov 2010 index 0
               end;
@@ -1088,13 +1105,13 @@ implementation
       end;
 
 
-    function parse_proc_dec(isclassmethod:boolean; aclass:tobjectdef):tprocdef;
+    function parse_proc_dec(isclassmethod:boolean;astruct:tabstractrecorddef):tprocdef;
       var
         pd : tprocdef;
         locationstr: string;
         old_parse_generic: boolean;
         popclass: integer;
-        old_current_objectdef,
+        old_current_structdef: tabstractrecorddef;
         old_current_genericdef,
         old_current_specializedef: tobjectdef;
       begin
@@ -1104,7 +1121,7 @@ implementation
           _FUNCTION :
             begin
               consume(_FUNCTION);
-              if parse_proc_head(aclass,potype_function,pd) then
+              if parse_proc_head(astruct,potype_function,pd) then
                 begin
                   { pd=nil when it is a interface mapping }
                   if assigned(pd) then
@@ -1115,32 +1132,32 @@ implementation
                          inc(testcurobject);
                          { Add ObjectSymtable to be able to find generic type definitions }
                          popclass:=0;
-                         if assigned(pd._class) and
+                         if assigned(pd.struct) and
                             (pd.parast.symtablelevel=normal_function_level) and
-                            (symtablestack.top.symtabletype<>ObjectSymtable) then
+                            not (symtablestack.top.symtabletype in [ObjectSymtable,recordsymtable]) then
                            begin
-                             popclass:=push_nested_hierarchy(pd._class);
-                             parse_generic:=(df_generic in pd._class.defoptions);
-                             old_current_objectdef:=current_objectdef;
+                             popclass:=push_nested_hierarchy(pd.struct);
+                             parse_generic:=(df_generic in pd.struct.defoptions);
+                             old_current_structdef:=current_structdef;
                              old_current_genericdef:=current_genericdef;
                              old_current_specializedef:=current_specializedef;
-                             current_objectdef:=pd._class;
-                             if assigned(current_objectdef) and (df_generic in current_objectdef.defoptions) then
-                               current_genericdef:=current_objectdef;
-                             if assigned(current_objectdef) and (df_specialization in current_objectdef.defoptions) then
-                               current_specializedef:=current_objectdef;
+                             current_structdef:=pd.struct;
+                             if assigned(current_structdef) and (df_generic in current_structdef.defoptions) then
+                               current_genericdef:=tobjectdef(current_structdef);
+                             if assigned(current_structdef) and (df_specialization in current_structdef.defoptions) then
+                               current_specializedef:=tobjectdef(current_structdef);
                            end;
                          single_type(pd.returndef,false,false);
 
-                         if is_dispinterface(pd._class) and not is_automatable(pd.returndef) then
+                         if is_dispinterface(pd.struct) and not is_automatable(pd.returndef) then
                            Message1(type_e_not_automatable,pd.returndef.typename);
 
                          if popclass>0 then
                            begin
-                             current_objectdef:=old_current_objectdef;
+                             current_structdef:=old_current_structdef;
                              current_genericdef:=old_current_genericdef;
                              current_specializedef:=old_current_specializedef;
-                             dec(popclass,pop_nested_hierarchy(pd._class));
+                             dec(popclass,pop_nested_hierarchy(pd.struct));
                              if popclass<>0 then
                                internalerror(201012020);
                            end;
@@ -1175,7 +1192,7 @@ implementation
                        begin
                           if (
                               parse_only and
-                              not(is_interface(pd._class))
+                              not(is_interface(pd.struct))
                              ) or
                              (m_repeat_forward in current_settings.modeswitches) then
                           begin
@@ -1198,7 +1215,7 @@ implementation
           _PROCEDURE :
             begin
               consume(_PROCEDURE);
-              if parse_proc_head(aclass,potype_procedure,pd) then
+              if parse_proc_head(astruct,potype_procedure,pd) then
                 begin
                   { pd=nil when it is an interface mapping }
                   if assigned(pd) then
@@ -1214,17 +1231,17 @@ implementation
             begin
               consume(_CONSTRUCTOR);
               if isclassmethod then
-                parse_proc_head(aclass,potype_class_constructor,pd)
+                parse_proc_head(astruct,potype_class_constructor,pd)
               else
-                parse_proc_head(aclass,potype_constructor,pd);
+                parse_proc_head(astruct,potype_constructor,pd);
               if not isclassmethod and
                  assigned(pd) and
-                 assigned(pd._class) then
+                 assigned(pd.struct) then
                 begin
                   { Set return type, class constructors return the
                     created instance, object constructors return boolean }
-                  if is_class(pd._class) then
-                    pd.returndef:=pd._class
+                  if is_class(pd.struct) or is_record(pd.struct) then
+                    pd.returndef:=pd.struct
                   else
 {$ifdef CPU64bitaddr}
                     pd.returndef:=bool64type;
@@ -1240,9 +1257,9 @@ implementation
             begin
               consume(_DESTRUCTOR);
               if isclassmethod then
-                parse_proc_head(aclass,potype_class_destructor,pd)
+                parse_proc_head(astruct,potype_class_destructor,pd)
               else
-                parse_proc_head(aclass,potype_destructor,pd);
+                parse_proc_head(astruct,potype_destructor,pd);
               if assigned(pd) then
                 pd.returndef:=voidtype;
             end;
@@ -1274,7 +1291,7 @@ implementation
                  end;
                end;
               consume(token);
-              parse_proc_head(aclass,potype_operator,pd);
+              parse_proc_head(astruct,potype_operator,pd);
               if assigned(pd) then
                 begin
                   { operators always need to be searched in all units }
@@ -1363,7 +1380,7 @@ procedure pd_export(pd:tabstractprocdef);
 begin
   if pd.typ<>procdef then
     internalerror(200304264);
-  if assigned(tprocdef(pd)._class) then
+  if assigned(tprocdef(pd).struct) then
     Message(parser_e_methods_dont_be_export);
   if pd.parast.symtablelevel>normal_function_level then
     Message(parser_e_dont_nest_export);
@@ -1461,7 +1478,8 @@ procedure pd_abstract(pd:tabstractprocdef);
 begin
   if pd.typ<>procdef then
     internalerror(200304269);
-  if oo_is_sealed in tprocdef(pd)._class.objectoptions then
+  if assigned(tprocdef(pd).struct) and
+    (oo_is_sealed in tprocdef(pd).struct.objectoptions) then
     Message(parser_e_sealed_class_cannot_have_abstract_methods)
   else
   if (po_virtualmethod in pd.procoptions) then
@@ -1490,13 +1508,13 @@ begin
   begin
     if pattern='MOVENEXT' then
     begin
-      if oo_has_enumerator_movenext in tprocdef(pd)._class.objectoptions then
+      if oo_has_enumerator_movenext in tprocdef(pd).struct.objectoptions then
         message(parser_e_only_one_enumerator_movenext);
       pd.calcparas;
       if (pd.proctypeoption = potype_function) and is_boolean(pd.returndef) and
          (pd.minparacount = 0) then
       begin
-        include(tprocdef(pd)._class.objectoptions, oo_has_enumerator_movenext);
+        include(tprocdef(pd).struct.objectoptions, oo_has_enumerator_movenext);
         include(pd.procoptions,po_enumerator_movenext);
       end
       else
@@ -1519,10 +1537,10 @@ begin
   if pd.typ<>procdef then
     internalerror(2003042610);
   if (pd.proctypeoption=potype_constructor) and
-     is_object(tprocdef(pd)._class) then
+     is_object(tprocdef(pd).struct) then
     Message(parser_e_constructor_cannot_be_not_virtual);
 {$ifdef WITHDMT}
-  if is_object(tprocdef(pd)._class) and
+  if is_object(tprocdef(pd).struct) and
      (token<>_SEMICOLON) then
     begin
        { any type of parameter is allowed here! }
@@ -1547,7 +1565,7 @@ var pt:Tnode;
 begin
   if pd.typ<>procdef then
     internalerror(200604301);
-  pt:=comp_expr(true);
+  pt:=comp_expr(true,false);
   if is_constintnode(pt) then
     if (Tordconstnode(pt).value<int64(low(longint))) or (Tordconstnode(pt).value>int64(high(longint))) then
       message(parser_e_range_check_error)
@@ -1570,9 +1588,9 @@ procedure pd_override(pd:tabstractprocdef);
 begin
   if pd.typ<>procdef then
     internalerror(2003042611);
-  if not(is_class_or_interface_or_objc(tprocdef(pd)._class)) then
+  if not(is_class_or_interface_or_objc(tprocdef(pd).struct)) then
     Message(parser_e_no_object_override)
-  else if is_objccategory(tprocdef(pd)._class) then
+  else if is_objccategory(tprocdef(pd).struct) then
     Message(parser_e_no_category_override);
 end;
 
@@ -1590,20 +1608,20 @@ var
 begin
   if pd.typ<>procdef then
     internalerror(2003042613);
-  if not is_class(tprocdef(pd)._class) and
-     not is_objc_class_or_protocol(tprocdef(pd)._class) then
+  if not is_class(tprocdef(pd).struct) and
+     not is_objc_class_or_protocol(tprocdef(pd).struct) then
     Message(parser_e_msg_only_for_classes);
   if ([po_msgstr,po_msgint]*pd.procoptions)<>[] then
     Message(parser_e_multiple_messages);
   { check parameter type }
-  if not is_objc_class_or_protocol(tprocdef(pd)._class) then
+  if not is_objc_class_or_protocol(tprocdef(pd).struct) then
     begin
       paracnt:=0;
       pd.parast.SymList.ForEachCall(@check_msg_para,@paracnt);
       if paracnt<>1 then
         Message(parser_e_ill_msg_param);
     end;
-  pt:=comp_expr(true);
+  pt:=comp_expr(true,false);
   { message is 1-character long }
   if is_constcharnode(pt) then
     begin
@@ -1619,7 +1637,7 @@ begin
     end
   else
    if is_constintnode(pt) and
-      is_class(tprocdef(pd)._class) then
+      is_class(tprocdef(pd).struct) then
     begin
       include(pd.procoptions,po_msgint);
       if (Tordconstnode(pt).value<int64(low(Tprocdef(pd).messageinf.i))) or
@@ -1632,7 +1650,7 @@ begin
     Message(parser_e_ill_msg_expr);
   { check whether the selector name is valid in case of Objective-C }
   if (po_msgstr in pd.procoptions) and
-     is_objc_class_or_protocol(tprocdef(pd)._class) and
+     is_objc_class_or_protocol(tprocdef(pd).struct) and
      not objcvalidselectorname(@tprocdef(pd).messageinf.str^[1],length(tprocdef(pd).messageinf.str^)) then
     Message1(type_e_invalid_objc_selector_name,tprocdef(pd).messageinf.str^);
   pt.free;
@@ -1643,8 +1661,8 @@ procedure pd_reintroduce(pd:tabstractprocdef);
 begin
   if pd.typ<>procdef then
     internalerror(200401211);
-  if not(is_class_or_interface_or_object(tprocdef(pd)._class)) and
-     not(is_objccategory(tprocdef(pd)._class)) then
+  if not(is_class_or_interface_or_object(tprocdef(pd).struct)) and
+     not(is_objccategory(tprocdef(pd).struct)) then
     Message(parser_e_no_object_reintroduce);
 end;
 
@@ -1925,7 +1943,7 @@ const
    (
     (
       idtok:_ABSTRACT;
-      pd_flags : [pd_interface,pd_object,pd_notobjintf];
+      pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_notrecord];
       handler  : @pd_abstract;
       pocall   : pocall_none;
       pooption : [po_abstractmethod];
@@ -1988,7 +2006,7 @@ const
       mutexclpo     : [po_interrupt,po_external,po_inline]
     ),(
       idtok:_DYNAMIC;
-      pd_flags : [pd_interface,pd_object,pd_notobjintf];
+      pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_notrecord];
       handler  : @pd_virtual;
       pocall   : pocall_none;
       pooption : [po_virtualmethod];
@@ -1997,7 +2015,7 @@ const
       mutexclpo     : [po_exports,po_interrupt,po_external,po_overridingmethod,po_inline]
     ),(
       idtok:_EXPORT;
-      pd_flags : [pd_body,pd_interface,pd_implemen,pd_notobjintf];
+      pd_flags : [pd_body,pd_interface,pd_implemen,pd_notobjintf,pd_notrecord];
       handler  : @pd_export;
       pocall   : pocall_none;
       pooption : [po_exports,po_global];
@@ -2006,7 +2024,7 @@ const
       mutexclpo     : [po_external,po_interrupt,po_inline]
     ),(
       idtok:_EXTERNAL;
-      pd_flags : [pd_implemen,pd_interface,pd_notobject,pd_notobjintf,pd_cppobject];
+      pd_flags : [pd_implemen,pd_interface,pd_notobject,pd_notobjintf,pd_cppobject,pd_notrecord];
       handler  : @pd_external;
       pocall   : pocall_none;
       pooption : [po_external];
@@ -2016,7 +2034,7 @@ const
       mutexclpo     : [po_public,po_exports,po_interrupt,po_assembler,po_inline]
     ),(
       idtok:_FAR;
-      pd_flags : [pd_implemen,pd_body,pd_interface,pd_procvar,pd_notobject,pd_notobjintf];
+      pd_flags : [pd_implemen,pd_body,pd_interface,pd_procvar,pd_notobject,pd_notobjintf,pd_notrecord];
       handler  : @pd_far;
       pocall   : pocall_none;
       pooption : [];
@@ -2025,7 +2043,7 @@ const
       mutexclpo     : [po_inline]
     ),(
       idtok:_FAR16;
-      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar,pd_notobject];
+      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar,pd_notobject,pd_notrecord];
       handler  : nil;
       pocall   : pocall_far16;
       pooption : [];
@@ -2034,7 +2052,7 @@ const
       mutexclpo     : [po_external]
     ),(
       idtok:_FINAL;
-      pd_flags : [pd_interface,pd_object,pd_notobjintf];
+      pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_notrecord];
       handler  : @pd_final;
       pocall   : pocall_none;
       pooption : [po_finalmethod];
@@ -2043,7 +2061,7 @@ const
       mutexclpo     : [po_exports,po_interrupt,po_external,po_inline]
     ),(
       idtok:_FORWARD;
-      pd_flags : [pd_implemen,pd_notobject,pd_notobjintf];
+      pd_flags : [pd_implemen,pd_notobject,pd_notobjintf,pd_notrecord];
       handler  : @pd_forward;
       pocall   : pocall_none;
       pooption : [];
@@ -2070,7 +2088,7 @@ const
       mutexclpo     : [po_exports,po_external,po_interrupt,po_virtualmethod]
     ),(
       idtok:_INTERNCONST;
-      pd_flags : [pd_interface,pd_body,pd_notobject,pd_notobjintf];
+      pd_flags : [pd_interface,pd_body,pd_notobject,pd_notobjintf,pd_notrecord];
       handler  : @pd_internconst;
       pocall   : pocall_none;
       pooption : [po_internconst];
@@ -2079,7 +2097,7 @@ const
       mutexclpo     : []
     ),(
       idtok:_INTERNPROC;
-      pd_flags : [pd_interface,pd_notobject,pd_notobjintf];
+      pd_flags : [pd_interface,pd_notobject,pd_notobjintf,pd_notrecord];
       handler  : @pd_internproc;
       pocall   : pocall_internproc;
       pooption : [];
@@ -2088,7 +2106,7 @@ const
       mutexclpo     : [po_exports,po_external,po_interrupt,po_assembler,po_iocheck,po_virtualmethod]
     ),(
       idtok:_INTERRUPT;
-      pd_flags : [pd_implemen,pd_body,pd_notobject,pd_notobjintf];
+      pd_flags : [pd_implemen,pd_body,pd_notobject,pd_notobjintf,pd_notrecord];
       handler  : @pd_interrupt;
       pocall   : pocall_oldfpccall;
       pooption : [po_interrupt];
@@ -2116,7 +2134,7 @@ const
       mutexclpo     : [po_external,po_exports]
     ),(
       idtok:_MESSAGE;
-      pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_objcclass, pd_objcprot];
+      pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_objcclass,pd_objcprot,pd_notrecord];
       handler  : @pd_message;
       pocall   : pocall_none;
       pooption : []; { can be po_msgstr or po_msgint }
@@ -2134,7 +2152,7 @@ const
       mutexclpo     : []
     ),(
       idtok:_NEAR;
-      pd_flags : [pd_implemen,pd_body,pd_procvar,pd_notobjintf];
+      pd_flags : [pd_implemen,pd_body,pd_procvar,pd_notobjintf,pd_notrecord];
       handler  : @pd_near;
       pocall   : pocall_none;
       pooption : [];
@@ -2161,7 +2179,7 @@ const
       mutexclpo     : []
     ),(
       idtok:_OVERRIDE;
-      pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_objcclass];
+      pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_objcclass,pd_notrecord];
       handler  : @pd_override;
       pocall   : pocall_none;
       pooption : [po_overridingmethod,po_virtualmethod];
@@ -2179,7 +2197,7 @@ const
       mutexclpo     : [po_external]
     ),(
       idtok:_PUBLIC;
-      pd_flags : [pd_interface,pd_implemen,pd_body,pd_notobject,pd_notobjintf];
+      pd_flags : [pd_interface,pd_implemen,pd_body,pd_notobject,pd_notobjintf,pd_notrecord];
       handler  : @pd_public;
       pocall   : pocall_none;
       pooption : [po_public,po_global];
@@ -2197,7 +2215,7 @@ const
       mutexclpo     : [po_external]
     ),(
       idtok:_REINTRODUCE;
-      pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_objcclass];
+      pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_objcclass,pd_notrecord];
       handler  : @pd_reintroduce;
       pocall   : pocall_none;
       pooption : [po_reintroduce];
@@ -2226,7 +2244,7 @@ const
       mutexclpo     : []
     ),(
       idtok:_STATIC;
-      pd_flags : [pd_interface,pd_implemen,pd_body,pd_object,pd_notobjintf];
+      pd_flags : [pd_interface,pd_implemen,pd_body,pd_object,pd_record,pd_notobjintf];
       handler  : @pd_static;
       pocall   : pocall_none;
       pooption : [po_staticmethod];
@@ -2256,7 +2274,7 @@ const
       mutexclpo     : [po_external,po_assembler,po_interrupt,po_exports]
     ),(
       idtok:_VIRTUAL;
-      pd_flags : [pd_interface,pd_object,pd_notobjintf];
+      pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_notrecord];
       handler  : @pd_virtual;
       pocall   : pocall_none;
       pooption : [po_virtualmethod];
@@ -2274,7 +2292,7 @@ const
       mutexclpo     : [po_assembler,po_external,po_virtualmethod]
     ),(
       idtok:_VARARGS;
-      pd_flags : [pd_interface,pd_implemen,pd_procvar,pd_objcclass, pd_objcprot];
+      pd_flags : [pd_interface,pd_implemen,pd_procvar,pd_objcclass,pd_objcprot];
       handler  : nil;
       pocall   : pocall_none;
       pooption : [po_varargs];
@@ -2293,7 +2311,7 @@ const
       mutexclpo     : [po_interrupt]
     ),(
       idtok:_WEAKEXTERNAL;
-      pd_flags : [pd_implemen,pd_interface,pd_notobject,pd_notobjintf,pd_cppobject];
+      pd_flags : [pd_implemen,pd_interface,pd_notobject,pd_notobjintf,pd_cppobject,pd_notrecord];
       handler  : @pd_weakexternal;
       pocall   : pocall_none;
       { mark it both external and weak external, so we don't have to
@@ -2380,7 +2398,7 @@ const
          begin
             { parsing a procvar type the name can be any
               next variable !! }
-            if ((pdflags * [pd_procvar,pd_object,pd_objcclass,pd_objcprot])=[]) and
+            if ((pdflags * [pd_procvar,pd_object,pd_record,pd_objcclass,pd_objcprot])=[]) and
                not(idtoken=_PROPERTY) then
               Message1(parser_w_unknown_proc_directive_ignored,name);
             exit;
@@ -2394,6 +2412,10 @@ const
            not(is_cppclass(tdef(symtablestack.top.defowner)) and (pd_cppobject in proc_direcdata[p].pd_flags)) then
            exit;
 
+        if (pd_notrecord in proc_direcdata[p].pd_flags) and
+           (symtablestack.top.symtabletype=recordsymtable) then
+           exit;
+
         { Conflicts between directives ? }
         if (pd.proctypeoption in proc_direcdata[p].mutexclpotype) or
            (pd.proccalloption in proc_direcdata[p].mutexclpocall) or
@@ -2427,26 +2449,31 @@ const
          begin
            { Check if the directive is only for objects }
            if (pd_object in proc_direcdata[p].pd_flags) and
-              not assigned(tprocdef(pd)._class) then
+              not assigned(tprocdef(pd).struct) then
+            exit;
+
+           { Check if the directive is only for records }
+           if (pd_record in proc_direcdata[p].pd_flags) and
+              not assigned(tprocdef(pd).struct) then
             exit;
 
            { check if method and directive not for interface }
            if (pd_notobjintf in proc_direcdata[p].pd_flags) and
-              is_interface(tprocdef(pd)._class) then
+              is_interface(tprocdef(pd).struct) then
             exit;
 
            { check if method and directive not for interface }
-           if is_dispinterface(tprocdef(pd)._class) and
+           if is_dispinterface(tprocdef(pd).struct) and
              not(pd_dispinterface in proc_direcdata[p].pd_flags) then
             exit;
 
            { check if method and directive not for objcclass }
-           if is_objcclass(tprocdef(pd)._class) and
+           if is_objcclass(tprocdef(pd).struct) and
              not(pd_objcclass in proc_direcdata[p].pd_flags) then
             exit;
 
            { check if method and directive not for objcprotocol }
-           if is_objcprotocol(tprocdef(pd)._class) and
+           if is_objcprotocol(tprocdef(pd).struct) and
              not(pd_objcprot in proc_direcdata[p].pd_flags) then
             exit;
 
@@ -2545,8 +2572,8 @@ const
             case pd.proccalloption of
               pocall_cdecl :
                 begin
-                  if assigned(pd._class) then
-                    result:=target_info.Cprefix+pd._class.objrealname^+'_'+pd.procsym.realname
+                  if assigned(pd.struct) then
+                    result:=target_info.Cprefix+pd.struct.objrealname^+'_'+pd.procsym.realname
                   else
                     result:=target_info.Cprefix+pd.procsym.realname;
                 end;
@@ -2616,8 +2643,8 @@ const
             case pd.proccalloption of
               pocall_cdecl :
                 begin
-                  if assigned(pd._class) then
-                   pd.aliasnames.insert(target_info.Cprefix+pd._class.objrealname^+'_'+pd.procsym.realname)
+                  if assigned(pd.struct) then
+                   pd.aliasnames.insert(target_info.Cprefix+pd.struct.objrealname^+'_'+pd.procsym.realname)
                   else
                     begin
                       { Export names are not mangled on Windows and OS/2, see also pexports.pas }
@@ -2643,13 +2670,13 @@ const
       begin
         { set the default calling convention if none provided }
         if (pd.typ=procdef) and
-           (is_objc_class_or_protocol(tprocdef(pd)._class) or
-            is_cppclass(tprocdef(pd)._class)) then
+           (is_objc_class_or_protocol(tprocdef(pd).struct) or
+            is_cppclass(tprocdef(pd).struct)) then
           begin
             { none of the explicit calling conventions should be allowed }
             if (po_hascallingconvention in pd.procoptions) then
               internalerror(2009032501);
-            if is_cppclass(tprocdef(pd)._class) then
+            if is_cppclass(tprocdef(pd).struct) then
               pd.proccalloption:=pocall_cppdecl
             else
               pd.proccalloption:=pocall_cdecl;
@@ -2704,7 +2731,7 @@ const
                      (pd.typ=procvardef) or
                      { for objcclasses this is checked later, because the entire
                        class may be external.  }
-                     is_objc_class_or_protocol(tprocdef(pd)._class)) and
+                     is_objc_class_or_protocol(tprocdef(pd).struct)) and
                  not(pd.proccalloption in (cdecl_pocalls + [pocall_mwpascal])) then
                 Message(parser_e_varargs_need_cdecl_and_external);
             end
@@ -2850,6 +2877,13 @@ const
         parse_proc_directives(pd,pdflags);
       end;
 
+    procedure parse_record_proc_directives(pd:tabstractprocdef);
+      var
+        pdflags : tpdflags;
+      begin
+        pdflags:=[pd_record];
+        parse_proc_directives(pd,pdflags);
+      end;
 
     function proc_add_definition(var currpd:tprocdef):boolean;
       {
@@ -3129,7 +3163,7 @@ const
                  { check if all procs have overloading, but not if the proc is a method or
                    already declared forward, then the check is already done }
                  if not(fwpd.hasforward or
-                        assigned(currpd._class) or
+                        assigned(currpd.struct) or
                         (currpd.forwarddef<>fwpd.forwarddef) or
                         ((po_overload in currpd.procoptions) and
                          (po_overload in fwpd.procoptions))) then

compiler/pdecvar.pas

@@ -33,7 +33,7 @@ interface
       tvar_dec_option=(vd_record,vd_object,vd_threadvar,vd_class);
       tvar_dec_options=set of tvar_dec_option;
 
-    function  read_property_dec(is_classproperty:boolean; aclass:tobjectdef):tpropertysym;
+    function  read_property_dec(is_classproperty:boolean;astruct:tabstractrecorddef):tpropertysym;
 
     procedure read_var_decls(options:Tvar_dec_options);
 
@@ -66,7 +66,7 @@ implementation
        ;
 
 
-    function read_property_dec(is_classproperty:boolean; aclass:tobjectdef):tpropertysym;
+    function read_property_dec(is_classproperty:boolean;astruct:tabstractrecorddef):tpropertysym;
 
         { convert a node tree to symlist and return the last
           symbol }
@@ -82,14 +82,14 @@ implementation
             def:=nil;
             if token=_ID then
              begin
-               if assigned(aclass) then
-                 sym:=search_class_member(aclass,pattern)
+               if assigned(astruct) then
+                 sym:=search_struct_member(astruct,pattern)
                else
                  searchsym(pattern,sym,srsymtable);
                if assigned(sym) then
                 begin
-                  if assigned(aclass) and
-                     not is_visible_for_object(sym,aclass) then
+                  if assigned(astruct) and
+                     not is_visible_for_object(sym,astruct) then
                     Message(parser_e_cant_access_private_member);
                   case sym.typ of
                     fieldvarsym :
@@ -137,7 +137,7 @@ implementation
                            begin
                              sym:=tsym(st.Find(pattern));
                              if not(assigned(sym)) and is_object(def) then
-                               sym:=search_class_member(tobjectdef(def),pattern);
+                               sym:=search_struct_member(tobjectdef(def),pattern);
                              if assigned(sym) then
                               begin
                                 pl.addsym(sl_subscript,sym);
@@ -177,7 +177,7 @@ implementation
                          if def.typ=arraydef then
                           begin
                             idx:=0;
-                            p:=comp_expr(true);
+                            p:=comp_expr(true,false);
                             if (not codegenerror) then
                              begin
                                if (p.nodetype=ordconstn) then
@@ -268,7 +268,7 @@ implementation
 
               if try_to_consume(_DISPID) then
                 begin
-                  pt:=comp_expr(true);
+                  pt:=comp_expr(true,false);
                   if is_constintnode(pt) then
                     if (Tordconstnode(pt).value<int64(low(longint))) or (Tordconstnode(pt).value>int64(high(longint))) then
                       message(parser_e_range_check_error)
@@ -279,7 +279,7 @@ implementation
                   pt.free;
                 end
               else
-                p.dispid:=aclass.get_next_dispid;
+                p.dispid:=tobjectdef(astruct).get_next_dispid;
             end;
 
           procedure add_index_parameter(var paranr: word; p: tpropertysym; readprocdef, writeprocdef, storedprocdef: tprocvardef);
@@ -324,7 +324,7 @@ implementation
          storedprocdef:=tprocvardef.create(normal_function_level);
 
          { make them method pointers }
-         if assigned(aclass) and not is_classproperty then
+         if assigned(astruct) and not is_classproperty then
            begin
              include(readprocdef.procoptions,po_methodpointer);
              include(writeprocdef.procoptions,po_methodpointer);
@@ -416,18 +416,18 @@ implementation
          { force property interface
              there is a property parameter
              a global property }
-         if (token=_COLON) or (paranr>0) or (aclass=nil) then
+         if (token=_COLON) or (paranr>0) or (astruct=nil) then
            begin
               consume(_COLON);
               single_type(p.propdef,false,false);
 
-              if is_dispinterface(aclass) and not is_automatable(p.propdef) then
+              if is_dispinterface(astruct) and not is_automatable(p.propdef) then
                 Message1(type_e_not_automatable,p.propdef.typename);
 
               if (idtoken=_INDEX) then
                 begin
                    consume(_INDEX);
-                   pt:=comp_expr(true);
+                   pt:=comp_expr(true,false);
                    { Only allow enum and integer indexes. Convert all integer
                      values to s32int to be compatible with delphi, because the
                      procedure matching requires equal parameters }
@@ -457,10 +457,13 @@ implementation
          else
            begin
               { do an property override }
-              overridden:=search_class_member(aclass.childof,p.name);
+              if (astruct.typ=objectdef) then
+                overridden:=search_struct_member(tobjectdef(astruct).childof,p.name)
+              else
+                overridden:=nil;
               if assigned(overridden) and
                  (overridden.typ=propertysym) and
-                 not(is_dispinterface(aclass)) then
+                 not(is_dispinterface(astruct)) then
                 begin
                   p.overriddenpropsym:=tpropertysym(overridden);
                   { inherit all type related entries }
@@ -478,14 +481,14 @@ implementation
                   message(parser_e_no_property_found_to_override);
                 end;
            end;
-         if ((p.visibility=vis_published) or is_dispinterface(aclass)) and
+         if ((p.visibility=vis_published) or is_dispinterface(astruct)) and
             (not(p.propdef.is_publishable) or (sp_static in p.symoptions)) then
            begin
              Message(parser_e_cant_publish_that_property);
              p.visibility:=vis_public;
            end;
 
-         if not(is_dispinterface(aclass)) then
+         if not(is_dispinterface(astruct)) then
            begin
              if try_to_consume(_READ) then
                begin
@@ -585,7 +588,8 @@ implementation
          else
            parse_dispinterface(p);
 
-         if assigned(aclass) and not(is_dispinterface(aclass)) and not is_classproperty then
+         { stored is not allowed for dispinterfaces, records or class properties }
+         if assigned(astruct) and not(is_dispinterface(astruct) or is_record(astruct)) and not is_classproperty then
            begin
              { ppo_stored is default on for not overridden properties }
              if not assigned(p.overriddenpropsym) then
@@ -617,8 +621,8 @@ implementation
                          { make sure we don't let constants mask class fields/
                            methods
                          }
-                         if (not assigned(aclass) or
-                             (search_class_member(aclass,pattern)=nil)) and
+                         if (not assigned(astruct) or
+                             (search_struct_member(astruct,pattern)=nil)) and
                             searchsym(pattern,sym,srsymtable) and
                             (sym.typ = constsym) then
                            begin
@@ -672,20 +676,20 @@ implementation
                 end;
               end;
            end;
-         if try_to_consume(_DEFAULT) then
+         if not is_record(astruct) and try_to_consume(_DEFAULT) then
            begin
               if not allow_default_property(p) then
                 begin
                   Message(parser_e_property_cant_have_a_default_value);
                   { Error recovery }
-                  pt:=comp_expr(true);
+                  pt:=comp_expr(true,false);
                   pt.free;
                 end
               else
                 begin
                   { Get the result of the default, the firstpass is
                     needed to support values like -1 }
-                  pt:=comp_expr(true);
+                  pt:=comp_expr(true,false);
                   if (p.propdef.typ=setdef) and
                      (pt.nodetype=arrayconstructorn) then
                     begin
@@ -713,7 +717,7 @@ implementation
                   pt.free;
                 end;
            end
-         else if try_to_consume(_NODEFAULT) then
+         else if not is_record(astruct) and try_to_consume(_NODEFAULT) then
            begin
               p.default:=longint($80000000);
            end;
@@ -724,7 +728,7 @@ implementation
            end;
 *)
          { Parse possible "implements" keyword }
-         if try_to_consume(_IMPLEMENTS) then
+         if not is_record(astruct) and try_to_consume(_IMPLEMENTS) then
            begin
              single_type(def,false,false);
 
@@ -782,9 +786,9 @@ implementation
                  exit;
                end;
              found:=false;
-             for i:=0 to aclass.ImplementedInterfaces.Count-1 do
+             for i:=0 to tobjectdef(astruct).ImplementedInterfaces.Count-1 do
                begin
-                 ImplIntf:=TImplementedInterface(aclass.ImplementedInterfaces[i]);
+                 ImplIntf:=TImplementedInterface(tobjectdef(astruct).ImplementedInterfaces[i]);
 
                  if compare_defs(def,ImplIntf.IntfDef,nothingn)>=te_equal then
                    begin
@@ -1407,7 +1411,8 @@ implementation
          sc:=TFPObjectList.create(false);
          recstlist:=TFPObjectList.create(false);;
          while (token=_ID) and
-            not((vd_object in options) and
+            not(((vd_object in options) or
+                 ((vd_record in options) and (m_extended_records in current_settings.modeswitches))) and
                 (idtoken in [_PUBLIC,_PRIVATE,_PUBLISHED,_PROTECTED,_STRICT])) do
            begin
              visibility:=symtablestack.top.currentvisibility;
@@ -1428,7 +1433,8 @@ implementation
              { Don't search in the recordsymtable for types (can be nested!) }
              recstlist.count:=0;
              if ([df_generic,df_specialization]*tdef(recst.defowner).defoptions=[]) and
-                 not is_class_or_object(tdef(recst.defowner)) then
+                 not is_class_or_object(tdef(recst.defowner)) and
+                 not is_record(tdef(recst.defowner)) then
                begin
                  recstlist.add(recst);
                  symtablestack.pop(recst);
@@ -1529,6 +1535,7 @@ implementation
                      consume(_SEMICOLON);
                      include(options, vd_class);
                    end;
+               end;
                  if vd_class in options then
                  begin
                    { add static flag and staticvarsyms }
@@ -1548,7 +1555,6 @@ implementation
                        recst.insert(tabsolutevarsym.create_ref('$'+static_name,hdef,sl));
                      end;
                  end;
-               end;
              if (visibility=vis_published) and
                 not(is_class(hdef)) then
                begin
@@ -1608,8 +1614,8 @@ implementation
                 Message(type_e_ordinal_expr_expected);
               consume(_OF);
 
-              UnionSymtable:=trecordsymtable.create(current_settings.packrecords);
-              UnionDef:=trecorddef.create(unionsymtable);
+              UnionSymtable:=trecordsymtable.create('',current_settings.packrecords);
+              UnionDef:=trecorddef.create('',unionsymtable);
               uniondef.isunion:=true;
               startvarrecsize:=UnionSymtable.datasize;
               { align the bitpacking to the next byte }
@@ -1619,11 +1625,11 @@ implementation
               symtablestack.push(UnionSymtable);
               repeat
                 repeat
-                  pt:=comp_expr(true);
+                  pt:=comp_expr(true,false);
                   if not(pt.nodetype=ordconstn) then
                     Message(parser_e_illegal_expression);
                   if try_to_consume(_POINTPOINT) then
-                    pt:=crangenode.create(pt,comp_expr(true));
+                    pt:=crangenode.create(pt,comp_expr(true,false));
                   pt.free;
                   if token=_COMMA then
                     consume(_COMMA)

compiler/pexports.pas

@@ -136,7 +136,7 @@ implementation
                      end;
                     if try_to_consume(_INDEX) then
                      begin
-                       pt:=comp_expr(true);
+                       pt:=comp_expr(true,false);
                        if pt.nodetype=ordconstn then
                         if (Tordconstnode(pt).value<int64(low(index))) or
                            (Tordconstnode(pt).value>int64(high(index))) then
@@ -160,7 +160,7 @@ implementation
                      end;
                     if try_to_consume(_NAME) then
                      begin
-                       pt:=comp_expr(true);
+                       pt:=comp_expr(true,false);
                        if pt.nodetype=stringconstn then
                          hpname:=strpas(tstringconstnode(pt).value_str)
                        else

compiler/pinline.pas

@@ -76,7 +76,7 @@ implementation
         storepos : tfileposinfo;
       begin
         consume(_LKLAMMER);
-        p:=comp_expr(true);
+        p:=comp_expr(true,false);
         { calc return type }
         if is_new then
           begin
@@ -98,12 +98,12 @@ implementation
               classh := classh.childof;
             if is_new then
               begin
-                sym:=search_class_member(classh,'CREATE');
+                sym:=search_struct_member(classh,'CREATE');
                 p2 := cloadvmtaddrnode.create(ctypenode.create(p.resultdef));
               end
             else
               begin
-                sym:=search_class_member(classh,'FREE');
+                sym:=search_struct_member(classh,'FREE');
                 p2 := p;
              end;
 
@@ -161,7 +161,7 @@ implementation
               begin
                  Message1(type_e_pointer_type_expected,p.resultdef.typename);
                  p.free;
-                 p:=factor(false);
+                 p:=factor(false,false);
                  p.free;
                  consume(_RKLAMMER);
                  new_dispose_statement:=cerrornode.create;
@@ -172,7 +172,7 @@ implementation
               begin
                  Message(parser_e_pointer_to_class_expected);
                  p.free;
-                 new_dispose_statement:=factor(false);
+                 new_dispose_statement:=factor(false,false);
                  consume_all_until(_RKLAMMER);
                  consume(_RKLAMMER);
                  exit;
@@ -182,7 +182,7 @@ implementation
             if is_class(classh) then
               begin
                  Message(parser_e_no_new_or_dispose_for_classes);
-                 new_dispose_statement:=factor(false);
+                 new_dispose_statement:=factor(false,false);
                  consume_all_until(_RKLAMMER);
                  consume(_RKLAMMER);
                  exit;
@@ -190,7 +190,7 @@ implementation
             { search cons-/destructor, also in parent classes }
             storepos:=current_tokenpos;
             current_tokenpos:=destructorpos;
-            sym:=search_class_member(classh,destructorname);
+            sym:=search_struct_member(classh,destructorname);
             current_tokenpos:=storepos;
 
             { the second parameter of new/dispose must be a call }
@@ -353,7 +353,7 @@ implementation
         again  : boolean; { dummy for do_proc_call }
       begin
         consume(_LKLAMMER);
-        p1:=factor(false);
+        p1:=factor(false,false);
         if p1.nodetype<>typen then
          begin
            Message(type_e_type_id_expected);

compiler/pmodules.pas

@@ -376,13 +376,13 @@ implementation
         ResourceStringTables.free;
       end;
 
-    procedure AddToClasInits(p:TObject;arg:pointer);
+    procedure AddToStructInits(p:TObject;arg:pointer);
       var
-        ClassList: TFPList absolute arg;
+        StructList: TFPList absolute arg;
       begin
-        if (tdef(p).typ=objectdef) and
-           ([oo_has_class_constructor,oo_has_class_destructor] * tobjectdef(p).objectoptions <> []) then
-          ClassList.Add(p);
+        if (tdef(p).typ in [objectdef,recorddef]) and
+           ([oo_has_class_constructor,oo_has_class_destructor] * tabstractrecorddef(p).objectoptions <> []) then
+          StructList.Add(p);
       end;
 
     procedure InsertInitFinalTable;
@@ -391,32 +391,32 @@ implementation
         unitinits : TAsmList;
         count : longint;
 
-        procedure write_class_inits(u: tmodule);
+        procedure write_struct_inits(u: tmodule);
           var
             i: integer;
-            classlist: TFPList;
+            structlist: TFPList;
             pd: tprocdef;
           begin
-            classlist := TFPList.Create;
+            structlist := TFPList.Create;
             if assigned(u.globalsymtable) then
-              u.globalsymtable.DefList.ForEachCall(@AddToClasInits,classlist);
-            u.localsymtable.DefList.ForEachCall(@AddToClasInits,classlist);
-            { write classes }
-            for i := 0 to classlist.Count - 1 do
+              u.globalsymtable.DefList.ForEachCall(@AddToStructInits,structlist);
+            u.localsymtable.DefList.ForEachCall(@AddToStructInits,structlist);
+            { write structures }
+            for i := 0 to structlist.Count - 1 do
             begin
-              pd := tobjectdef(classlist[i]).find_procdef_bytype(potype_class_constructor);
+              pd := tabstractrecorddef(structlist[i]).find_procdef_bytype(potype_class_constructor);
               if assigned(pd) then
                 unitinits.concat(Tai_const.Createname(pd.mangledname,0))
               else
                 unitinits.concat(Tai_const.Create_pint(0));
-              pd := tobjectdef(classlist[i]).find_procdef_bytype(potype_class_destructor);
+              pd := tabstractrecorddef(structlist[i]).find_procdef_bytype(potype_class_destructor);
               if assigned(pd) then
                 unitinits.concat(Tai_const.Createname(pd.mangledname,0))
               else
                 unitinits.concat(Tai_const.Create_pint(0));
               inc(count);
             end;
-            classlist.free;
+            structlist.free;
           end;
 
       begin
@@ -427,7 +427,7 @@ implementation
          begin
            { insert class constructors/destructors of the unit }
            if (hp.u.flags and uf_classinits) <> 0 then
-             write_class_inits(hp.u);
+             write_struct_inits(hp.u);
            { call the unit init code and make it external }
            if (hp.u.flags and (uf_init or uf_finalize))<>0 then
              begin
@@ -445,7 +445,7 @@ implementation
          end;
         { insert class constructors/destructor of the program }
         if (current_module.flags and uf_classinits) <> 0 then
-          write_class_inits(current_module);
+          write_struct_inits(current_module);
         { Insert initialization/finalization of the program }
         if (current_module.flags and (uf_init or uf_finalize))<>0 then
           begin

compiler/ppcgen/cgppc.pas

@@ -666,7 +666,7 @@ unit cgppc;
           if (procdef.extnumber=$ffff) then
             Internalerror(200006139);
           { call/jmp  vmtoffs(%eax) ; method offs }
-          reference_reset_base(href,NR_R11,procdef._class.vmtmethodoffset(procdef.extnumber),sizeof(pint));
+          reference_reset_base(href,NR_R11,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
           if hasLargeOffset(href) then
             begin
 {$ifdef cpu64}
@@ -696,7 +696,7 @@ unit cgppc;
       begin
         if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
           Internalerror(200006137);
-        if not assigned(procdef._class) or
+        if not assigned(procdef.struct) or
            (procdef.procoptions*[po_classmethod, po_staticmethod,
              po_methodpointer, po_interrupt, po_iocheck]<>[]) then
           Internalerror(200006138);

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 121;
+  CurrentPPUVersion = 123;
 
 { buffer sizes }
   maxentrysize = 1024;

compiler/pstatmnt.pas

@@ -71,7 +71,7 @@ implementation
          ex,if_a,else_a : tnode;
       begin
          consume(_IF);
-         ex:=comp_expr(true);
+         ex:=comp_expr(true,false);
          consume(_THEN);
          if token<>_ELSE then
            if_a:=statement
@@ -125,7 +125,7 @@ implementation
          casenode : tcasenode;
       begin
          consume(_CASE);
-         caseexpr:=comp_expr(true);
+         caseexpr:=comp_expr(true,false);
          { determines result type }
          do_typecheckpass(caseexpr);
          { variants must be accepted, but first they must be converted to integer }
@@ -300,7 +300,7 @@ implementation
          consume(_UNTIL);
 
          first:=cblocknode.create(first);
-         p_e:=comp_expr(true);
+         p_e:=comp_expr(true,false);
          result:=cwhilerepeatnode.create(p_e,first,false,true);
       end;
 
@@ -312,7 +312,7 @@ implementation
 
       begin
          consume(_WHILE);
-         p_e:=comp_expr(true);
+         p_e:=comp_expr(true,false);
          consume(_DO);
          p_a:=statement;
          result:=cwhilerepeatnode.create(p_e,p_a,true,false);
@@ -424,7 +424,7 @@ implementation
              else
                MessagePos(hloopvar.fileinfo,type_e_illegal_count_var);
 
-             hfrom:=comp_expr(true);
+             hfrom:=comp_expr(true,false);
 
              if try_to_consume(_DOWNTO) then
                backward:=true
@@ -434,7 +434,7 @@ implementation
                  backward:=false;
                end;
 
-             hto:=comp_expr(true);
+             hto:=comp_expr(true,false);
              consume(_DO);
 
              { Check if the constants fit in the range }
@@ -471,7 +471,7 @@ implementation
             var
               expr: tnode;
             begin
-              expr:=comp_expr(true);
+              expr:=comp_expr(true,false);
 
               consume(_DO);
 
@@ -490,7 +490,7 @@ implementation
          { parse loop header }
          consume(_FOR);
 
-         hloopvar:=factor(false);
+         hloopvar:=factor(false,false);
          valid_for_loopvar(hloopvar,true);
 
          if try_to_consume(_ASSIGNMENT) then
@@ -533,7 +533,7 @@ implementation
 
 
       begin
-         p:=comp_expr(true);
+         p:=comp_expr(true,false);
          do_typecheckpass(p);
 
          if (p.nodetype=vecn) and
@@ -725,12 +725,12 @@ implementation
          if not(token in endtokens) then
            begin
               { object }
-              pobj:=comp_expr(true);
+              pobj:=comp_expr(true,false);
               if try_to_consume(_AT) then
                 begin
-                   paddr:=comp_expr(true);
+                   paddr:=comp_expr(true,false);
                    if try_to_consume(_COMMA) then
-                     pframe:=comp_expr(true);
+                     pframe:=comp_expr(true,false);
                 end;
            end
          else
@@ -1204,8 +1204,7 @@ implementation
                     { can be nil in case there was an error in the expression }
                     assigned(tcallnode(p).procdefinition) and
                     not((tcallnode(p).procdefinition.proctypeoption=potype_constructor) and
-                        assigned(tprocdef(tcallnode(p).procdefinition)._class) and
-                        is_object(tprocdef(tcallnode(p).procdefinition)._class)) then
+                        is_object(tprocdef(tcallnode(p).procdefinition).struct)) then
                    Message(parser_e_illegal_expression);
                end;
              code:=p;
@@ -1314,7 +1313,7 @@ implementation
              if (current_procinfo.procdef.localst.symtabletype=localsymtable) then
                inc(locals,tabstractlocalsymtable(current_procinfo.procdef.localst).count_locals);
              if (locals=0) and
-                (current_procinfo.procdef.owner.symtabletype<>ObjectSymtable) and
+                not (current_procinfo.procdef.owner.symtabletype in [ObjectSymtable,recordsymtable]) and
                 (not assigned(current_procinfo.procdef.funcretsym) or
                  (tabstractvarsym(current_procinfo.procdef.funcretsym).refs<=1)) and
                 not(paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef.proccalloption)) then

compiler/psub.pas

@@ -290,15 +290,15 @@ implementation
       begin
         result:=internalstatements(newstatement);
 
-        if assigned(current_objectdef) then
+        if assigned(current_structdef) then
           begin
             { a constructor needs a help procedure }
             if (current_procinfo.procdef.proctypeoption=potype_constructor) then
               begin
-                if is_class(current_objectdef) then
+                if is_class(current_structdef) then
                   begin
                     include(current_procinfo.flags,pi_needs_implicit_finally);
-                    srsym:=search_class_member(current_objectdef,'NEWINSTANCE');
+                    srsym:=search_struct_member(current_objectdef,'NEWINSTANCE');
                     if assigned(srsym) and
                        (srsym.typ=procsym) then
                       begin
@@ -320,7 +320,7 @@ implementation
                       internalerror(200305108);
                   end
                 else
-                  if is_object(current_objectdef) then
+                  if is_object(current_structdef) then
                     begin
                       { parameter 3 : vmt_offset }
                       { parameter 2 : address of pointer to vmt,
@@ -345,10 +345,12 @@ implementation
                           ccallnode.createintern('fpc_help_constructor',para)));
                     end
                 else
+                  if not is_record(current_structdef) then
                   internalerror(200305103);
                 { if self=nil then exit
                   calling fail instead of exit is useless because
                   there is nothing to dispose (PFV) }
+                if is_class_or_object(current_structdef) then
                 addstatement(newstatement,cifnode.create(
                     caddnode.create(equaln,
                         load_self_pointer_node,
@@ -359,9 +361,9 @@ implementation
 
             { maybe call BeforeDestruction for classes }
             if (current_procinfo.procdef.proctypeoption=potype_destructor) and
-               is_class(current_objectdef) then
+               is_class(current_structdef) then
               begin
-                srsym:=search_class_member(current_objectdef,'BEFOREDESTRUCTION');
+                srsym:=search_struct_member(current_objectdef,'BEFOREDESTRUCTION');
                 if assigned(srsym) and
                    (srsym.typ=procsym) then
                   begin
@@ -393,7 +395,7 @@ implementation
       begin
         result:=internalstatements(newstatement);
 
-        if assigned(current_objectdef) then
+        if assigned(current_structdef) then
           begin
             { Don't test self and the vmt here. The reason is that  }
             { a constructor already checks whether these are valid  }
@@ -406,9 +408,9 @@ implementation
             { a destructor needs a help procedure }
             if (current_procinfo.procdef.proctypeoption=potype_destructor) then
               begin
-                if is_class(current_objectdef) then
+                if is_class(current_structdef) then
                   begin
-                    srsym:=search_class_member(current_objectdef,'FREEINSTANCE');
+                    srsym:=search_struct_member(current_objectdef,'FREEINSTANCE');
                     if assigned(srsym) and
                        (srsym.typ=procsym) then
                       begin
@@ -430,7 +432,7 @@ implementation
                       internalerror(200305108);
                   end
                 else
-                  if is_object(current_objectdef) then
+                  if is_object(current_structdef) then
                     begin
                       { finalize object data }
                       if is_managed_type(current_objectdef) then
@@ -471,7 +473,7 @@ implementation
 
         { a constructor needs call destructor (if available) when it
           is not inherited }
-        if not assigned(current_objectdef) or
+        if not assigned(current_structdef) or
            (current_procinfo.procdef.proctypeoption<>potype_constructor) then
           begin
             { no constructor }
@@ -495,7 +497,7 @@ implementation
                 { if safecall is used for a class method we need to call }
                 { SafecallException virtual method                       }
                 { In other case we return E_UNEXPECTED error value       }
-                if is_class(current_procinfo.procdef._class) then
+                if is_class(current_procinfo.procdef.struct) then
                   begin
                     { temp variable to store exception address }
                     exceptaddrnode:=ctempcreatenode.create(voidpointertype,voidpointertype.size,
@@ -513,7 +515,7 @@ implementation
                       cassignmentnode.create(
                         ctemprefnode.create(exceptobjnode),
                         ccallnode.createintern('fpc_popobjectstack', nil)));
-                    exceptsym:=search_class_member(current_procinfo.procdef._class,'SAFECALLEXCEPTION');
+                    exceptsym:=search_struct_member(tobjectdef(current_procinfo.procdef.struct),'SAFECALLEXCEPTION');
                     addstatement(newstatement,
                       cassignmentnode.create(
                         cloadnode.create(sym,sym.Owner),
@@ -595,7 +597,7 @@ implementation
         newstatement: tstatementnode;
         pd: tprocdef;
       begin
-        if assigned(current_objectdef) and
+        if assigned(current_structdef) and
            (current_procinfo.procdef.proctypeoption=potype_constructor) then
           begin
             { Don't test self and the vmt here. See generate_bodyexit_block }
@@ -604,9 +606,9 @@ implementation
             current_settings.localswitches:=oldlocalswitches-[cs_check_object,cs_check_range];
 
             { call AfterConstruction for classes }
-            if is_class(current_objectdef) then
+            if is_class(current_structdef) then
               begin
-                srsym:=search_class_member(current_objectdef,'AFTERCONSTRUCTION');
+                srsym:=search_struct_member(current_objectdef,'AFTERCONSTRUCTION');
                 if assigned(srsym) and
                    (srsym.typ=procsym) then
                   begin
@@ -806,7 +808,7 @@ implementation
         old_current_procinfo : tprocinfo;
         oldmaxfpuregisters : longint;
         oldfilepos : tfileposinfo;
-        old_current_objectdef : tobjectdef;
+        old_current_structdef : tabstractrecorddef;
         templist : TAsmList;
         headertai : tai;
         i : integer;
@@ -833,12 +835,12 @@ implementation
 
         old_current_procinfo:=current_procinfo;
         oldfilepos:=current_filepos;
-        old_current_objectdef:=current_objectdef;
+        old_current_structdef:=current_structdef;
         oldmaxfpuregisters:=current_settings.maxfpuregisters;
 
         current_procinfo:=self;
         current_filepos:=entrypos;
-        current_objectdef:=procdef._class;
+        current_structdef:=procdef.struct;
 
         templist:=TAsmList.create;
 
@@ -1265,7 +1267,7 @@ implementation
         templist.free;
         current_settings.maxfpuregisters:=oldmaxfpuregisters;
         current_filepos:=oldfilepos;
-        current_objectdef:=old_current_objectdef;
+        current_structdef:=old_current_structdef;
         current_procinfo:=old_current_procinfo;
       end;
 
@@ -1273,11 +1275,11 @@ implementation
     procedure tcgprocinfo.add_to_symtablestack;
       begin
         { insert symtables for the class, but only if it is no nested function }
-        if assigned(procdef._class) and
+        if assigned(procdef.struct) and
            not(assigned(parent) and
                assigned(parent.procdef) and
-               assigned(parent.procdef._class)) then
-          push_nested_hierarchy(procdef._class);
+               assigned(parent.procdef.struct)) then
+          push_nested_hierarchy(procdef.struct);
 
         { insert parasymtable in symtablestack when parsing
           a function }
@@ -1303,11 +1305,11 @@ implementation
           symtablestack.pop(procdef.parast);
 
         { remove symtables for the class, but only if it is no nested function }
-        if assigned(procdef._class) and
+        if assigned(procdef.struct) and
            not(assigned(parent) and
                assigned(parent.procdef) and
-               assigned(parent.procdef._class)) then
-          pop_nested_hierarchy(procdef._class);
+               assigned(parent.procdef.struct)) then
+          pop_nested_hierarchy(procdef.struct);
       end;
 
 
@@ -1379,22 +1381,22 @@ implementation
          old_current_procinfo : tprocinfo;
          old_block_type : tblock_type;
          st : TSymtable;
-         old_current_objectdef,
+         old_current_structdef: tabstractrecorddef;
          old_current_genericdef,
          old_current_specializedef : tobjectdef;
       begin
          old_current_procinfo:=current_procinfo;
          old_block_type:=block_type;
-         old_current_objectdef:=current_objectdef;
+         old_current_structdef:=current_structdef;
          old_current_genericdef:=current_genericdef;
          old_current_specializedef:=current_specializedef;
 
          current_procinfo:=self;
-         current_objectdef:=procdef._class;
-         if assigned(current_objectdef) and (df_generic in current_objectdef.defoptions) then
-           current_genericdef:=current_objectdef;
-         if assigned(current_objectdef) and (df_specialization in current_objectdef.defoptions) then
-           current_specializedef:=current_objectdef;
+         current_structdef:=procdef.struct;
+         if assigned(current_structdef) and (df_generic in current_structdef.defoptions) then
+           current_genericdef:=tobjectdef(current_structdef);
+         if assigned(current_structdef) and (df_specialization in current_structdef.defoptions) then
+           current_specializedef:=tobjectdef(current_structdef);
 
          { calculate the lexical level }
          if procdef.parast.symtablelevel>maxnesting then
@@ -1500,7 +1502,7 @@ implementation
 {    aktstate.destroy;}
     {$endif state_tracking}
 
-         current_objectdef:=old_current_objectdef;
+         current_structdef:=old_current_structdef;
          current_genericdef:=old_current_genericdef;
          current_specializedef:=old_current_specializedef;
          current_procinfo:=old_current_procinfo;
@@ -1646,7 +1648,7 @@ implementation
 
       var
         old_current_procinfo : tprocinfo;
-        old_current_objectdef,
+        old_current_structdef: tabstractrecorddef;
         old_current_genericdef,
         old_current_specializedef : tobjectdef;
         pdflags    : tpdflags;
@@ -1655,19 +1657,19 @@ implementation
       begin
          { save old state }
          old_current_procinfo:=current_procinfo;
-         old_current_objectdef:=current_objectdef;
+         old_current_structdef:=current_structdef;
          old_current_genericdef:=current_genericdef;
          old_current_specializedef:=current_specializedef;
 
          { reset current_procinfo.procdef to nil to be sure that nothing is writing
            to another procdef }
          current_procinfo:=nil;
-         current_objectdef:=nil;
+         current_structdef:=nil;
          current_genericdef:=nil;
          current_specializedef:=nil;
 
          { parse procedure declaration }
-         pd:=parse_proc_dec(isclassmethod, old_current_objectdef);
+         pd:=parse_proc_dec(isclassmethod,old_current_structdef);
 
          { set the default function options }
          if parse_only then
@@ -1710,8 +1712,8 @@ implementation
          if not proc_add_definition(pd) then
            begin
              { A method must be forward defined (in the object declaration) }
-             if assigned(pd._class) and
-                (not assigned(old_current_objectdef)) then
+             if assigned(pd.struct) and
+                (not assigned(old_current_structdef)) then
               begin
                 MessagePos1(pd.fileinfo,parser_e_header_dont_match_any_member,pd.fullprocname(false));
                 tprocsym(pd.procsym).write_parameter_lists(pd);
@@ -1792,7 +1794,7 @@ implementation
                current_asmdata.DefineAsmSymbol(pd.mangledname,AB_LOCAL,AT_FUNCTION);
            end;
 
-         current_objectdef:=old_current_objectdef;
+         current_structdef:=old_current_structdef;
          current_genericdef:=old_current_genericdef;
          current_specializedef:=old_current_specializedef;
          current_procinfo:=old_current_procinfo;
@@ -1842,7 +1844,7 @@ implementation
                      if not(token in [_FUNCTION,_PROCEDURE,_PROPERTY,_VAR,_CONSTRUCTOR,_DESTRUCTOR]) then
                        Message(parser_e_procedure_or_function_expected);
 
-                     if is_interface(current_objectdef) then
+                     if is_interface(current_structdef) then
                        Message(parser_e_no_static_method_in_interfaces)
                      else
                        { class methods are also allowed for Objective-C protocols }

compiler/psystem.pas

@@ -347,8 +347,8 @@ implementation
           end;
         addtype('$s64currency',s64currencytype);
         { Add a type for virtual method tables }
-        hrecst:=trecordsymtable.create(current_settings.packrecords);
-        vmttype:=trecorddef.create(hrecst);
+        hrecst:=trecordsymtable.create('',current_settings.packrecords);
+        vmttype:=trecorddef.create('',hrecst);
         pvmttype:=tpointerdef.create(vmttype);
         { can't use addtype for pvmt because the rtti of the pointed
           type is not available. The rtti for pvmt will be written implicitly
@@ -371,10 +371,10 @@ implementation
         tarraydef(vmtarraytype).elementdef:=pvmttype;
         addtype('$vtblarray',vmtarraytype);
         { Add a type for methodpointers }
-        hrecst:=trecordsymtable.create(1);
+        hrecst:=trecordsymtable.create('',1);
         addfield(hrecst,tfieldvarsym.create('$proc',vs_value,voidpointertype,[]));
         addfield(hrecst,tfieldvarsym.create('$self',vs_value,voidpointertype,[]));
-        methodpointertype:=trecorddef.create(hrecst);
+        methodpointertype:=trecorddef.create('',hrecst);
         addtype('$methodpointer',methodpointertype);
         symtablestack.pop(systemunit);
       end;

compiler/ptconst.pas

@@ -27,7 +27,7 @@ interface
 
    uses symtype,symsym,aasmdata;
 
-    procedure read_typed_const(list:tasmlist;sym:tstaticvarsym;in_class:boolean);
+    procedure read_typed_const(list:tasmlist;sym:tstaticvarsym;in_structure:boolean);
 
 
 implementation
@@ -191,7 +191,7 @@ implementation
           end;
 
         begin
-           n:=comp_expr(true);
+           n:=comp_expr(true,false);
            { for C-style booleans, true=-1 and false=0) }
            if is_cbool(def) then
              inserttypeconv(n,def);
@@ -291,7 +291,7 @@ implementation
           n : tnode;
           value : bestreal;
         begin
-          n:=comp_expr(true);
+          n:=comp_expr(true,false);
           if is_constrealnode(n) then
             value:=trealconstnode(n).value_real
           else if is_constintnode(n) then
@@ -332,7 +332,7 @@ implementation
         var
           n : tnode;
         begin
-          n:=comp_expr(true);
+          n:=comp_expr(true,false);
           case n.nodetype of
             loadvmtaddrn:
               begin
@@ -369,7 +369,7 @@ implementation
           ll        : tasmlabel;
           varalign  : shortint;
         begin
-          p:=comp_expr(true);
+          p:=comp_expr(true,false);
           { remove equal typecasts for pointer/nil addresses }
           if (p.nodetype=typeconvn) then
             with Ttypeconvnode(p) do
@@ -587,7 +587,7 @@ implementation
           p : tnode;
           i : longint;
         begin
-          p:=comp_expr(true);
+          p:=comp_expr(true,false);
           if p.nodetype=setconstn then
             begin
               { be sure to convert to the correct result, else
@@ -622,7 +622,7 @@ implementation
         var
           p : tnode;
         begin
-          p:=comp_expr(true);
+          p:=comp_expr(true,false);
           if p.nodetype=ordconstn then
             begin
               if equal_defs(p.resultdef,def) or
@@ -653,7 +653,7 @@ implementation
           ca        : pchar;
           winlike   : boolean;
         begin
-          n:=comp_expr(true);
+          n:=comp_expr(true,false);
           { load strval and strlength of the constant tree }
           if (n.nodetype=stringconstn) or is_wide_or_unicode_string(def) or is_constwidecharnode(n) or
             ((n.nodetype=typen) and is_interfacecorba(ttypenode(n).typedef)) then
@@ -772,7 +772,7 @@ implementation
             n : tnode;
           begin
             result:=true;
-            n:=comp_expr(true);
+            n:=comp_expr(true,false);
             if (n.nodetype <> ordconstn) or
                (not equal_defs(n.resultdef,def) and
                 not is_subequal(n.resultdef,def)) then
@@ -873,7 +873,7 @@ implementation
           else if is_anychar(def.elementdef) then
             begin
                char_size:=def.elementdef.size;
-               n:=comp_expr(true);
+               n:=comp_expr(true,false);
                if n.nodetype=stringconstn then
                  begin
                    len:=tstringconstnode(n).len;
@@ -970,7 +970,7 @@ implementation
             Message(parser_e_no_procvarobj_const);
           { parse the rest too, so we can continue with error checking }
           getprocvardef:=def;
-          n:=comp_expr(true);
+          n:=comp_expr(true,false);
           getprocvardef:=nil;
           if codegenerror then
             begin
@@ -1062,7 +1062,7 @@ implementation
           { GUID }
           if (def=rec_tguid) and (token=_ID) then
             begin
-              n:=comp_expr(true);
+              n:=comp_expr(true,false);
               if n.nodetype=stringconstn then
                 handle_stringconstn
               else
@@ -1085,7 +1085,7 @@ implementation
             end;
           if (def=rec_tguid) and ((token=_CSTRING) or (token=_CCHAR)) then
             begin
-              n:=comp_expr(true);
+              n:=comp_expr(true,false);
               inserttypeconv(n,cshortstringtype);
               if n.nodetype=stringconstn then
                 handle_stringconstn
@@ -1278,7 +1278,7 @@ implementation
           { only allow nil for class and interface }
           if is_class_or_interface_or_dispinterface_or_objc(def) then
             begin
-              n:=comp_expr(true);
+              n:=comp_expr(true,false);
               if n.nodetype<>niln then
                 begin
                   Message(parser_e_type_const_not_possible);
@@ -1429,7 +1429,7 @@ implementation
 
 {$maxfpuregisters default}
 
-    procedure read_typed_const(list:tasmlist;sym:tstaticvarsym;in_class:boolean);
+    procedure read_typed_const(list:tasmlist;sym:tstaticvarsym;in_structure:boolean);
       var
         storefilepos : tfileposinfo;
         cursectype   : TAsmSectionType;
@@ -1461,7 +1461,7 @@ implementation
         consume(_SEMICOLON);
 
         { parse public/external/export/... }
-        if not in_class and
+        if not in_structure and
            (
             (
              (token = _ID) and

compiler/ptype.pas

@@ -72,7 +72,7 @@ implementation
        nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
        { parser }
        scanner,
-       pbase,pexpr,pdecsub,pdecvar,pdecobj;
+       pbase,pexpr,pdecsub,pdecvar,pdecobj,pdecl;
 
 
     procedure resolve_forward_types;
@@ -191,7 +191,7 @@ implementation
           begin
             consume(_LSHARPBRACKET);
             repeat
-              pt2:=factor(false);
+              pt2:=factor(false,true);
               pt2.free;
             until not try_to_consume(_COMMA);
             consume(_RSHARPBRACKET);
@@ -227,7 +227,7 @@ implementation
                   consume(_COMMA)
                 else
                   first:=false;
-                pt2:=factor(false);
+                pt2:=factor(false,true);
                 if pt2.nodetype=typen then
                   begin
                     if df_generic in pt2.resultdef.defoptions then
@@ -253,9 +253,9 @@ implementation
           consume(_RSHARPBRACKET);
 
         { Special case if we are referencing the current defined object }
-        if assigned(current_objectdef) and
-           (current_objectdef.objname^=uspecializename) then
-          tt:=current_objectdef;
+        if assigned(current_structdef) and
+           (current_structdef.objname^=uspecializename) then
+          tt:=current_structdef;
 
         { for units specializations can already be needed in the interface, therefor we
           will use the global symtable. Programs don't have a globalsymtable and there we
@@ -373,7 +373,7 @@ implementation
         srsymtable : TSymtable;
         s,sorg : TIDString;
         t : ttoken;
-        objdef : tobjectdef;
+        structdef : tabstractrecorddef;
       begin
          s:=pattern;
          sorg:=orgpattern;
@@ -381,20 +381,20 @@ implementation
          { use of current parsed object:
             - classes can be used also in classes
             - objects can be parameters }
-         objdef:=current_objectdef;
-         while Assigned(objdef) and (objdef.typ=objectdef) do
+         structdef:=current_structdef;
+         while Assigned(structdef) and (structdef.typ in [objectdef,recorddef]) do
            begin
-             if (tobjectdef(objdef).objname^=pattern) and
+             if (structdef.objname^=pattern) and
                 (
                   (testcurobject=2) or
-                  is_class_or_interface_or_objc(objdef)
+                  is_class_or_interface_or_objc(structdef)
                 ) then
                 begin
                   consume(_ID);
-                  def:=objdef;
+                  def:=structdef;
                   exit;
                 end;
-             objdef:=tobjectdef(tobjectdef(objdef).owner.defowner);
+             structdef:=tabstractrecorddef(structdef.owner.defowner);
            end;
          { Use the special searchsym_type that ignores records and parameters }
          searchsym_type(s,srsym,srsymtable);
@@ -505,12 +505,12 @@ implementation
                                 consume(_POINT);
                                 consume(_ID);
                              end
-                            else if is_class_or_object(def) then
+                            else if is_class_or_object(def) or is_record(def) then
                               begin
-                                symtablestack.push(tobjectdef(def).symtable);
+                                symtablestack.push(tabstractrecorddef(def).symtable);
                                 consume(_POINT);
                                 id_type(t2,isforwarddef);
-                                symtablestack.pop(tobjectdef(def).symtable);
+                                symtablestack.pop(tabstractrecorddef(def).symtable);
                                 def:=t2;
                               end
                             else
@@ -551,27 +551,303 @@ implementation
           end;
       end;
 
+    procedure parse_record_members;
+
+        procedure maybe_parse_hint_directives(pd:tprocdef);
+        var
+          dummysymoptions : tsymoptions;
+          deprecatedmsg : pshortstring;
+        begin
+          dummysymoptions:=[];
+          deprecatedmsg:=nil;
+          while try_consume_hintdirective(dummysymoptions,deprecatedmsg) do
+            Consume(_SEMICOLON);
+          if assigned(pd) then
+            begin
+              pd.symoptions:=pd.symoptions+dummysymoptions;
+              pd.deprecatedmsg:=deprecatedmsg;
+            end
+          else
+            stringdispose(deprecatedmsg);
+        end;
+
+      var
+        pd : tprocdef;
+        oldparse_only: boolean;
+        member_blocktype : tblock_type;
+        fields_allowed, is_classdef, classfields: boolean;
+        vdoptions: tvar_dec_options;
+      begin
+        { empty record declaration ? }
+        if (token=_SEMICOLON) then
+          Exit;
+
+        current_structdef.symtable.currentvisibility:=vis_public;
+        testcurobject:=1;
+        fields_allowed:=true;
+        is_classdef:=false;
+        classfields:=false;
+        member_blocktype:=bt_general;
+        repeat
+          case token of
+            _TYPE :
+              begin
+                consume(_TYPE);
+                member_blocktype:=bt_type;
+              end;
+            _VAR :
+              begin
+                consume(_VAR);
+                fields_allowed:=true;
+                member_blocktype:=bt_general;
+                classfields:=is_classdef;
+                is_classdef:=false;
+              end;
+            _CONST:
+              begin
+                consume(_CONST);
+                member_blocktype:=bt_const;
+              end;
+            _ID, _CASE :
+              begin
+                case idtoken of
+                  _PRIVATE :
+                    begin
+                       consume(_PRIVATE);
+                       current_structdef.symtable.currentvisibility:=vis_private;
+                       include(current_structdef.objectoptions,oo_has_private);
+                       fields_allowed:=true;
+                       is_classdef:=false;
+                       classfields:=false;
+                       member_blocktype:=bt_general;
+                     end;
+                   _PROTECTED :
+                     begin
+                       consume(_PROTECTED);
+                       current_structdef.symtable.currentvisibility:=vis_protected;
+                       include(current_structdef.objectoptions,oo_has_protected);
+                       fields_allowed:=true;
+                       is_classdef:=false;
+                       classfields:=false;
+                       member_blocktype:=bt_general;
+                     end;
+                   _PUBLIC :
+                     begin
+                       consume(_PUBLIC);
+                       current_structdef.symtable.currentvisibility:=vis_public;
+                       fields_allowed:=true;
+                       is_classdef:=false;
+                       classfields:=false;
+                       member_blocktype:=bt_general;
+                     end;
+                   _PUBLISHED :
+                     begin
+                       Message(parser_e_no_record_published);
+                       consume(_PUBLISHED);
+                       current_structdef.symtable.currentvisibility:=vis_published;
+                       fields_allowed:=true;
+                       is_classdef:=false;
+                       classfields:=false;
+                       member_blocktype:=bt_general;
+                     end;
+                   _STRICT :
+                     begin
+                        consume(_STRICT);
+                        if token=_ID then
+                          begin
+                            case idtoken of
+                              _PRIVATE:
+                                begin
+                                  consume(_PRIVATE);
+                                  current_structdef.symtable.currentvisibility:=vis_strictprivate;
+                                  include(current_structdef.objectoptions,oo_has_strictprivate);
+                                end;
+                              _PROTECTED:
+                                begin
+                                  consume(_PROTECTED);
+                                  current_structdef.symtable.currentvisibility:=vis_strictprotected;
+                                  include(current_structdef.objectoptions,oo_has_strictprotected);
+                                end;
+                              else
+                                message(parser_e_protected_or_private_expected);
+                            end;
+                          end
+                        else
+                          message(parser_e_protected_or_private_expected);
+                        fields_allowed:=true;
+                        is_classdef:=false;
+                        classfields:=false;
+                        member_blocktype:=bt_general;
+                     end
+                    else
+                      begin
+                        if member_blocktype=bt_general then
+                          begin
+                            if (not fields_allowed) then
+                              Message(parser_e_field_not_allowed_here);
+                            vdoptions:=[vd_record];
+                            if classfields then
+                              include(vdoptions,vd_class);
+                            read_record_fields(vdoptions);
+                          end
+                        else if member_blocktype=bt_type then
+                          types_dec(true)
+                        else if member_blocktype=bt_const then
+                          consts_dec(true)
+                        else
+                          internalerror(201001110);
+                      end;
+                end;
+              end;
+            _PROPERTY :
+              begin
+                struct_property_dec(is_classdef);
+                fields_allowed:=false;
+                is_classdef:=false;
+              end;
+            _CLASS:
+              begin
+                is_classdef:=false;
+                { read class method }
+                if try_to_consume(_CLASS) then
+                 begin
+                   { class modifier is only allowed for procedures, functions, }
+                   { constructors, destructors, fields and properties          }
+                   if not(token in [_FUNCTION,_PROCEDURE,_PROPERTY,_VAR,_CONSTRUCTOR,_DESTRUCTOR]) then
+                     Message(parser_e_procedure_or_function_expected);
+
+                   is_classdef:=true;
+                 end;
+              end;
+            _PROCEDURE,
+            _FUNCTION:
+              begin
+                oldparse_only:=parse_only;
+                parse_only:=true;
+                pd:=parse_proc_dec(is_classdef,current_structdef);
+
+                { this is for error recovery as well as forward }
+                { interface mappings, i.e. mapping to a method  }
+                { which isn't declared yet                      }
+                if assigned(pd) then
+                  begin
+                    parse_record_proc_directives(pd);
+
+                    { since records have no inheritance don't allow non static
+                      class methods. delphi do so. }
+                    if is_classdef and not (po_staticmethod in pd.procoptions) then
+                      MessagePos(pd.fileinfo, parser_e_class_methods_only_static_in_records);
+
+                    handle_calling_convention(pd);
+
+                    { add definition to procsym }
+                    proc_add_definition(pd);
+                  end;
+
+                maybe_parse_hint_directives(pd);
+
+                parse_only:=oldparse_only;
+                fields_allowed:=false;
+                is_classdef:=false;
+              end;
+            _CONSTRUCTOR :
+              begin
+                if not is_classdef then
+                  Message(parser_e_no_constructor_in_records);
+                if not is_classdef and (current_structdef.symtable.currentvisibility <> vis_public) then
+                  Message(parser_w_constructor_should_be_public);
+
+                { only 1 class constructor is allowed }
+                if is_classdef and (oo_has_class_constructor in current_structdef.objectoptions) then
+                  Message1(parser_e_only_one_class_constructor_allowed, current_structdef.objrealname^);
+
+                oldparse_only:=parse_only;
+                parse_only:=true;
+                if is_classdef then
+                  pd:=class_constructor_head
+                else
+                  pd:=constructor_head;
+                parse_record_proc_directives(pd);
+                handle_calling_convention(pd);
+
+                { add definition to procsym }
+                proc_add_definition(pd);
+
+                maybe_parse_hint_directives(pd);
+
+                parse_only:=oldparse_only;
+                fields_allowed:=false;
+                is_classdef:=false;
+              end;
+            _DESTRUCTOR :
+              begin
+                if not is_classdef then
+                  Message(parser_e_no_destructor_in_records);
+
+                { only 1 class destructor is allowed }
+                if is_classdef and (oo_has_class_destructor in current_structdef.objectoptions) then
+                  Message1(parser_e_only_one_class_destructor_allowed, current_structdef.objrealname^);
+
+                oldparse_only:=parse_only;
+                parse_only:=true;
+                if is_classdef then
+                  pd:=class_destructor_head
+                else
+                  pd:=destructor_head;
+                parse_record_proc_directives(pd);
+                handle_calling_convention(pd);
+
+                { add definition to procsym }
+                proc_add_definition(pd);
+
+                maybe_parse_hint_directives(pd);
+
+                parse_only:=oldparse_only;
+                fields_allowed:=false;
+                is_classdef:=false;
+              end;
+            _END :
+              begin
+                consume(_END);
+                break;
+              end;
+            else
+              consume(_ID); { Give a ident expected message, like tp7 }
+          end;
+        until false;
+
+        testcurobject:=0;
+      end;
+
     { reads a record declaration }
-    function record_dec : tdef;
+    function record_dec(const n:tidstring):tdef;
       var
+         old_current_structdef : tabstractrecorddef;
          recst : trecordsymtable;
       begin
+         old_current_structdef:=current_structdef;
          { create recdef }
-         recst:=trecordsymtable.create(current_settings.packrecords);
-         record_dec:=trecorddef.create(recst);
+         recst:=trecordsymtable.create(n,current_settings.packrecords);
+         current_structdef:=trecorddef.create(n,recst);
+         result:=current_structdef;
          { insert in symtablestack }
          symtablestack.push(recst);
          { parse record }
          consume(_RECORD);
+         if m_extended_records in current_settings.modeswitches then
+           parse_record_members
+         else
+           begin
          read_record_fields([vd_record]);
          consume(_END);
+           end;
          { make the record size aligned }
          recst.addalignmentpadding;
          { restore symtable stack }
          symtablestack.pop(recst);
-         if trecorddef(record_dec).is_packed and
-            is_managed_type(record_dec) then
+         if trecorddef(current_structdef).is_packed and is_managed_type(current_structdef) then
            Message(type_e_no_packed_inittable);
+         current_structdef:=old_current_structdef;
       end;
 
 
@@ -592,7 +868,7 @@ implementation
            lv,hv   : TConstExprInt;
            old_block_type : tblock_type;
            dospecialize : boolean;
-           objdef: TDef;
+           structdef: TDef;
         begin
            old_block_type:=block_type;
            dospecialize:=false;
@@ -601,32 +877,32 @@ implementation
               - objects can be parameters }
            if (token=_ID) then
              begin
-               objdef:=current_objectdef;
-               while Assigned(objdef) and (objdef.typ=objectdef) do
+               structdef:=current_structdef;
+               while Assigned(structdef) and (structdef.typ in [objectdef,recorddef]) do
                  begin
-                   if (tobjectdef(objdef).objname^=pattern) and
+                   if (tabstractrecorddef(structdef).objname^=pattern) and
                       (
                         (testcurobject=2) or
-                        is_class_or_interface_or_objc(objdef)
+                        is_class_or_interface_or_objc(structdef)
                       ) then
                       begin
                         consume(_ID);
-                        def:=objdef;
+                        def:=structdef;
                         exit;
                       end;
-                   objdef:=tobjectdef(tobjectdef(objdef).owner.defowner);
+                   structdef:=tdef(tabstractrecorddef(structdef).owner.defowner);
                  end;
              end;
            { Generate a specialization? }
            if try_to_consume(_SPECIALIZE) then
              dospecialize:=true;
            { we can't accept a equal in type }
-           pt1:=comp_expr(false);
+           pt1:=comp_expr(false,true);
            if not dospecialize and
               try_to_consume(_POINTPOINT) then
              begin
                { get high value of range }
-               pt2:=comp_expr(false);
+               pt2:=comp_expr(false,false);
                { make both the same type or give an error. This is not
                  done when both are integer values, because typecasting
                  between -3200..3200 will result in a signed-unsigned
@@ -936,7 +1212,7 @@ implementation
                     begin
                        oldlocalswitches:=current_settings.localswitches;
                        include(current_settings.localswitches,cs_allow_enum_calc);
-                       p:=comp_expr(true);
+                       p:=comp_expr(true,false);
                        current_settings.localswitches:=oldlocalswitches;
                        if (p.nodetype=ordconstn) then
                         begin
@@ -992,7 +1268,7 @@ implementation
               end;
             _RECORD:
               begin
-                def:=record_dec;
+                def:=record_dec(name);
               end;
             _PACKED,
             _BITPACKED:
@@ -1027,7 +1303,7 @@ implementation
                           def:=object_dec(odt_object,name,genericdef,genericlist,nil);
                         end;
                       else
-                        def:=record_dec;
+                        def:=record_dec(name);
                     end;
                     current_settings.packrecords:=oldpackrecords;
                   end;

compiler/rautils.pas

@@ -1334,10 +1334,7 @@ Begin
       i:=255;
      base:=Copy(s,1,i-1);
      delete(s,1,i);
-     if st.symtabletype=ObjectSymtable then
-       sym:=search_class_member(tobjectdef(st.defowner),base)
-     else
-       sym:=tsym(st.Find(base));
+     sym:=search_struct_member(tabstractrecorddef(st.defowner),base);
      if not assigned(sym) then
       begin
         GetRecordOffsetSize:=false;
@@ -1398,7 +1395,7 @@ Begin
                  begin
                    { size = sizeof(target_system_pointer) }
                    size:=sizeof(pint);
-                   offset:=procdef._class.vmtmethodoffset(procdef.extnumber)
+                   offset:=tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber)
                  end;
              end;
            { if something comes after the procsym, it's invalid assembler syntax }

compiler/sparc/cgcpu.pas

@@ -1355,7 +1355,7 @@ implementation
       begin
         if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
           Internalerror(200006137);
-        if not assigned(procdef._class) or
+        if not assigned(procdef.struct) or
            (procdef.procoptions*[po_classmethod, po_staticmethod,
              po_methodpointer, po_interrupt, po_iocheck]<>[]) then
           Internalerror(200006138);
@@ -1384,7 +1384,7 @@ implementation
             cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_G1);
             g1_used:=true; 
             { jmp *vmtoffs(%eax) ; method offs }
-            reference_reset_base(href,NR_G1,procdef._class.vmtmethodoffset(procdef.extnumber),sizeof(pint));
+            reference_reset_base(href,NR_G1,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
             list.concat(taicpu.op_ref_reg(A_LD,href,NR_G1));
             list.concat(taicpu.op_reg(A_JMP,NR_G1));
 	    g1_used:=false;

compiler/symdef.pas

@@ -168,18 +168,30 @@ interface
           function  GetTypeName:string;override;
        end;
 
+       tprocdef = class;
+       { tabstractrecorddef }
+
        tabstractrecorddef= class(tstoreddef)
+          objname,
+          objrealname: PShortString;
           symtable : TSymtable;
           cloneddef      : tabstractrecorddef;
           cloneddefderef : tderef;
+          objectoptions  : tobjectoptions;
+          constructor create(const n:string; dt:tdeftyp);
+          constructor ppuload(dt:tdeftyp;ppufile:tcompilerppufile);
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          destructor destroy; override;
+          function find_procdef_bytype(pt:tproctypeoption): tprocdef;
           function  GetSymtable(t:tGetSymtable):TSymtable;override;
           function is_packed:boolean;
+          function RttiName: string;
        end;
 
        trecorddef = class(tabstractrecorddef)
        public
           isunion       : boolean;
-          constructor create(p : TSymtable);
+          constructor create(const n:string; p:TSymtable);
           constructor ppuload(ppufile:tcompilerppufile);
           destructor destroy;override;
           function getcopy : tstoreddef;override;
@@ -194,7 +206,6 @@ interface
           function  needs_inittable : boolean;override;
        end;
 
-       tprocdef = class;
        tobjectdef = class;
 
        { TImplementedInterface }
@@ -243,11 +254,8 @@ interface
 
           { for C++ classes: name of the library this class is imported from }
           import_lib,
-          objname,
-          objrealname,
           { for Objective-C: protocols and classes can have the same name there }
           objextname     : pshortstring;
-          objectoptions  : tobjectoptions;
           { to be able to have a variable vmt position }
           { and no vmt field for objects without virtuals }
           vmtentries     : TFPList;
@@ -271,7 +279,7 @@ interface
           classref_created_in_current_module : boolean;
           { store implemented interfaces defs and name mappings }
           ImplementedInterfaces : TFPObjectList;
-          constructor create(ot : tobjecttyp;const n : string;c : tobjectdef);
+          constructor create(ot:tobjecttyp;const n:string;c:tobjectdef);
           constructor ppuload(ppufile:tcompilerppufile);
           destructor  destroy;override;
           function getcopy : tstoreddef;override;
@@ -299,7 +307,6 @@ interface
           procedure check_forwards;
           procedure insertvmt;
           procedure set_parent(c : tobjectdef);
-          function find_procdef_bytype(pt:tproctypeoption): tprocdef;
           function find_destructor: tprocdef;
           function implements_any_interfaces: boolean;
           { dispinterface support }
@@ -320,7 +327,6 @@ interface
           function check_objc_types: boolean;
           { C++ }
           procedure finish_cpp_data;
-          function RttiName: string;
        end;
 
        tclassrefdef = class(tabstractpointerdef)
@@ -500,8 +506,8 @@ interface
           localst : TSymtable;
           funcretsym : tsym;
           funcretsymderef : tderef;
-          _class : tobjectdef;
-          _classderef : tderef;
+          struct : tabstractrecorddef;
+          structderef : tderef;
 {$if defined(powerpc) or defined(m68k)}
           { library symbol for AmigaOS/MorphOS }
           libsym : tsym;
@@ -631,7 +637,8 @@ interface
        end;
 
     var
-       current_objectdef : tobjectdef;  { used for private functions check !! }
+       current_structdef: tabstractrecorddef;
+       current_objectdef : tobjectdef absolute current_structdef;  { used for private functions check !! }
        current_genericdef : tobjectdef; { used to reject declaration of generic class inside generic class }
        current_specializedef : tobjectdef; { used to implement usage of generic class in itself }
 
@@ -775,6 +782,7 @@ interface
     function is_class_or_interface_or_dispinterface(def: tdef): boolean;
     function is_class_or_interface_or_dispinterface_or_objc(def: tdef): boolean;
     function is_class_or_object(def: tdef): boolean;
+    function is_record(def: tdef): boolean;
 
     procedure loadobjctypes;
     procedure maybeloadcocoatypes;
@@ -866,11 +874,11 @@ implementation
            st:=st.defowner.owner;
          end;
         { object/classes symtable, nested type definitions in classes require the while loop }
-        while st.symtabletype=ObjectSymtable do
+        while st.symtabletype in [ObjectSymtable,recordsymtable] do
          begin
-           if st.defowner.typ<>objectdef then
+           if not (st.defowner.typ in [objectdef,recorddef]) then
             internalerror(200204174);
-           prefix:=tobjectdef(st.defowner).objname^+'_$_'+prefix;
+           prefix:=tabstractrecorddef(st.defowner).objname^+'_$_'+prefix;
            st:=st.defowner.owner;
          end;
         { symtable must now be static or global }
@@ -2551,6 +2559,54 @@ implementation
                               tabstractrecorddef
 ***************************************************************************}
 
+    constructor tabstractrecorddef.create(const n:string; dt:tdeftyp);
+      begin
+        inherited create(dt);
+        objname:=stringdup(upper(n));
+        objrealname:=stringdup(n);
+        objectoptions:=[];
+      end;
+
+    constructor tabstractrecorddef.ppuload(dt:tdeftyp;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(dt,ppufile);
+        objrealname:=stringdup(ppufile.getstring);
+        objname:=stringdup(upper(objrealname^));
+        ppufile.getsmallset(objectoptions);
+      end;
+
+    procedure tabstractrecorddef.ppuwrite(ppufile: tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppufile.putstring(objrealname^);
+        ppufile.putsmallset(objectoptions);
+      end;
+
+    destructor tabstractrecorddef.destroy;
+      begin
+        stringdispose(objname);
+        stringdispose(objrealname);
+        inherited destroy;
+      end;
+
+    function tabstractrecorddef.find_procdef_bytype(pt:tproctypeoption): tprocdef;
+      var
+        i: longint;
+        sym: tsym;
+      begin
+        for i:=0 to symtable.SymList.Count-1 do
+          begin
+            sym:=tsym(symtable.SymList[i]);
+            if sym.typ=procsym then
+              begin
+                result:=tprocsym(sym).find_procdef_bytype(pt);
+                if assigned(result) then
+                  exit;
+              end;
+          end;
+          result:=nil;
+      end;
+
     function tabstractrecorddef.GetSymtable(t:tGetSymtable):TSymtable;
       begin
          if t=gs_record then
@@ -2565,14 +2621,29 @@ implementation
         result:=tabstractrecordsymtable(symtable).is_packed;
       end;
 
+    function tabstractrecorddef.RttiName: string;
+      var
+        tmp: tabstractrecorddef;
+      begin
+        Result:=objrealname^;
+        tmp:=self;
+        repeat
+          if tmp.owner.symtabletype in [ObjectSymtable,recordsymtable] then
+            tmp:=tabstractrecorddef(tmp.owner.defowner)
+          else
+            break;
+          Result:=tmp.objrealname^+'.'+Result;
+        until tmp=nil;
+      end;
+
 
 {***************************************************************************
                                   trecorddef
 ***************************************************************************}
 
-    constructor trecorddef.create(p : TSymtable);
+    constructor trecorddef.create(const n:string; p:TSymtable);
       begin
-         inherited create(recorddef);
+         inherited create(n,recorddef);
          symtable:=p;
          { we can own the symtable only if nobody else owns a copy so far }
          if symtable.refcount=1 then
@@ -2588,7 +2659,7 @@ implementation
            ppufile.getderef(cloneddefderef)
          else
            begin
-             symtable:=trecordsymtable.create(0);
+             symtable:=trecordsymtable.create(objrealname^,0);
              trecordsymtable(symtable).fieldalignment:=shortint(ppufile.getbyte);
              trecordsymtable(symtable).recordalignment:=shortint(ppufile.getbyte);
              trecordsymtable(symtable).padalignment:=shortint(ppufile.getbyte);
@@ -2615,7 +2686,7 @@ implementation
 
     function trecorddef.getcopy : tstoreddef;
       begin
-        result:=trecorddef.create(symtable.getcopy);
+        result:=trecorddef.create(objrealname^,symtable.getcopy);
         trecorddef(result).isunion:=isunion;
         include(trecorddef(result).defoptions,df_copied_def);
       end;
@@ -3088,7 +3159,7 @@ implementation
          forwarddef:=true;
          interfacedef:=false;
          hasforward:=false;
-         _class := nil;
+         struct := nil;
          import_dll:=nil;
          import_name:=nil;
          import_nr:=0;
@@ -3112,7 +3183,7 @@ implementation
           _mangledname:=nil;
          extnumber:=ppufile.getword;
          level:=ppufile.getbyte;
-         ppufile.getderef(_classderef);
+         ppufile.getderef(structderef);
          ppufile.getderef(procsymderef);
          ppufile.getposinfo(fileinfo);
          visibility:=tvisibility(ppufile.getbyte);
@@ -3254,7 +3325,7 @@ implementation
 
          ppufile.putword(extnumber);
          ppufile.putbyte(parast.symtablelevel);
-         ppufile.putderef(_classderef);
+         ppufile.putderef(structderef);
          ppufile.putderef(procsymderef);
          ppufile.putposinfo(fileinfo);
          ppufile.putbyte(byte(visibility));
@@ -3340,9 +3411,9 @@ implementation
         showhidden:=true;
 {$endif EXTDEBUG}
         s:='';
-        if assigned(_class) then
+        if assigned(struct) then
          begin
-           s:=_class.RttiName+'.';
+           s:=struct.RttiName+'.';
            if (po_classmethod in procoptions) and
               not (proctypeoption in [potype_class_constructor,potype_class_destructor]) then
              s:='class ' + s;
@@ -3417,7 +3488,7 @@ implementation
     procedure tprocdef.buildderef;
       begin
          inherited buildderef;
-         _classderef.build(_class);
+         structderef.build(struct);
          { procsym that originaly defined this definition, should be in the
            same symtable }
          procsymderef.build(procsym);
@@ -3451,7 +3522,7 @@ implementation
     procedure tprocdef.deref;
       begin
          inherited deref;
-         _class:=tobjectdef(_classderef.resolve);
+         struct:=tabstractrecorddef(structderef.resolve);
          { procsym that originaly defined this definition, should be in the
            same symtable }
          procsym:=tprocsym(procsymderef.resolve);
@@ -3915,20 +3986,17 @@ implementation
                               TOBJECTDEF
 ***************************************************************************}
 
-   constructor tobjectdef.create(ot : tobjecttyp;const n : string;c : tobjectdef);
+   constructor tobjectdef.create(ot:tobjecttyp;const n:string;c:tobjectdef);
      begin
-        inherited create(objectdef);
+        inherited create(n,objectdef);
         fcurrent_dispid:=0;
         objecttype:=ot;
-        objectoptions:=[];
         childof:=nil;
         symtable:=tObjectSymtable.create(self,n,current_settings.packrecords);
         { create space for vmt !! }
         vmtentries:=TFPList.Create;
         vmt_offset:=0;
         set_parent(c);
-        objname:=stringdup(upper(n));
-        objrealname:=stringdup(n);
         if objecttype in [odt_interfacecorba,odt_interfacecom,odt_dispinterface] then
           prepareguid;
         { setup implemented interfaces }
@@ -3950,8 +4018,6 @@ implementation
       begin
          inherited ppuload(objectdef,ppufile);
          objecttype:=tobjecttyp(ppufile.getbyte);
-         objrealname:=stringdup(ppufile.getstring);
-         objname:=stringdup(upper(objrealname^));
          objextname:=stringdup(ppufile.getstring);
          { only used for external Objective-C classes/protocols }
          if (objextname^='') then
@@ -3966,7 +4032,6 @@ implementation
          tObjectSymtable(symtable).recordalignment:=ppufile.getbyte;
          vmt_offset:=ppufile.getlongint;
          ppufile.getderef(childofderef);
-         ppufile.getsmallset(objectoptions);
 
          { load guid }
          iidstr:=nil;
@@ -4036,8 +4101,6 @@ implementation
              symtable.free;
              symtable:=nil;
            end;
-         stringdispose(objname);
-         stringdispose(objrealname);
          stringdispose(objextname);
          stringdispose(import_lib);
          stringdispose(iidstr);
@@ -4070,14 +4133,10 @@ implementation
       var
         i : longint;
       begin
-        result:=tobjectdef.create(objecttype,objname^,childof);
+        result:=tobjectdef.create(objecttype,objrealname^,childof);
         { the constructor allocates a symtable which we release to avoid memory leaks }
         tobjectdef(result).symtable.free;
         tobjectdef(result).symtable:=symtable.getcopy;
-        if assigned(objname) then
-          tobjectdef(result).objname:=stringdup(objname^);
-        if assigned(objrealname) then
-          tobjectdef(result).objrealname:=stringdup(objrealname^);
         if assigned(objextname) then
           tobjectdef(result).objextname:=stringdup(objextname^);
         if assigned(import_lib) then
@@ -4123,7 +4182,6 @@ implementation
          ppufile.do_indirect_crc:=true;
          inherited ppuwrite(ppufile);
          ppufile.putbyte(byte(objecttype));
-         ppufile.putstring(objrealname^);
          if assigned(objextname) then
            ppufile.putstring(objextname^)
          else
@@ -4137,7 +4195,6 @@ implementation
          ppufile.putbyte(tObjectSymtable(symtable).recordalignment);
          ppufile.putlongint(vmt_offset);
          ppufile.putderef(childofderef);
-         ppufile.putsmallset(objectoptions);
          if objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface] then
            begin
               ppufile.putguid(iidguid^);
@@ -4489,24 +4546,6 @@ implementation
         is_related:=false;
      end;
 
-   function tobjectdef.find_procdef_bytype(pt:tproctypeoption): tprocdef;
-     var
-       i: longint;
-       sym: tsym;
-     begin
-       for i:=0 to symtable.SymList.Count-1 do
-         begin
-           sym:=tsym(symtable.SymList[i]);
-           if sym.typ=procsym then
-             begin
-               result:=tprocsym(sym).find_procdef_bytype(pt);
-               if assigned(result) then
-                 exit;
-             end;
-         end;
-         result:=nil;
-     end;
-
    function tobjectdef.find_destructor: tprocdef;
      var
        objdef: tobjectdef;
@@ -4940,7 +4979,7 @@ implementation
             else
               { all checks already done }
               exit;
-            if not(oo_is_external in pd._class.objectoptions) then
+            if not(oo_is_external in pd.struct.objectoptions) then
               begin
                 if (po_varargs in pd.procoptions) then
                   MessagePos(pd.fileinfo,parser_e_varargs_need_cdecl_and_external)
@@ -5035,11 +5074,11 @@ implementation
         if (def.typ=procdef) then
           begin
             pd.setmangledname(target_info.Cprefix+pd.cplusplusmangledname);
-            if (oo_is_external in pd._class.objectoptions) then
+            if (oo_is_external in pd.struct.objectoptions) then
               begin
                 { copied from psub.read_proc }
-                if assigned(pd._class.import_lib) then
-                   current_module.AddExternalImport(pd._class.import_lib^,pd.mangledname,0,false,false)
+                if assigned(tobjectdef(pd.struct).import_lib) then
+                   current_module.AddExternalImport(tobjectdef(pd.struct).import_lib^,pd.mangledname,0,false,false)
                  else
                    begin
                      { add import name to external list for DLL scanning }
@@ -5057,22 +5096,6 @@ implementation
         self.symtable.DefList.ForEachCall(@do_cpp_import_info,nil);
       end;
 
-    function tobjectdef.RttiName: string;
-      var
-        tmp: tobjectdef;
-      begin
-        Result:=objrealname^;
-        tmp:=self;
-        repeat
-          if tmp.owner.symtabletype=ObjectSymtable then
-            tmp:=tobjectdef(tmp.owner.defowner)
-          else
-            break;
-          Result:=tmp.objrealname^+'.'+Result;
-        until tmp=nil;
-      end;
-
-
 {****************************************************************************
                              TImplementedInterface
 ****************************************************************************}
@@ -5469,6 +5492,13 @@ implementation
           (tobjectdef(def).objecttype in [odt_class,odt_object]);
       end;
 
+    function is_record(def: tdef): boolean;
+      begin
+        result:=
+          assigned(def) and
+          (def.typ=recorddef);
+      end;
+
     procedure loadobjctypes;
       begin
         objc_metaclasstype:=tpointerdef(search_named_unit_globaltype('OBJC','POBJC_CLASS',true).typedef);

compiler/symtable.pas

@@ -104,7 +104,7 @@ interface
 
        trecordsymtable = class(tabstractrecordsymtable)
        public
-          constructor create(usealign:shortint);
+          constructor create(const n:string;usealign:shortint);
           procedure insertunionst(unionst : trecordsymtable;offset : longint);
        end;
 
@@ -200,19 +200,20 @@ interface
 
 {*** Search ***}
     procedure addsymref(sym:tsym);
-    function  is_visible_for_object(symst:tsymtable;symvisibility:tvisibility;contextobjdef:tobjectdef):boolean;
-    function  is_visible_for_object(pd:tprocdef;contextobjdef:tobjectdef):boolean;
-    function  is_visible_for_object(sym:tsym;contextobjdef:tobjectdef):boolean;
+    function  is_visible_for_object(symst:tsymtable;symvisibility:tvisibility;contextobjdef:tabstractrecorddef):boolean;
+    function  is_visible_for_object(pd:tprocdef;contextobjdef:tabstractrecorddef):boolean;
+    function  is_visible_for_object(sym:tsym;contextobjdef:tabstractrecorddef):boolean;
     function  searchsym(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
     function  searchsym_type(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
     function  searchsym_in_module(pm:pointer;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
     function  searchsym_in_named_module(const unitname, symname: TIDString; out srsym: tsym; out srsymtable: tsymtable): boolean;
     function  searchsym_in_class(classh,contextclassh:tobjectdef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
+    function  searchsym_in_record(recordh:tabstractrecorddef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
     function  searchsym_in_class_by_msgint(classh:tobjectdef;msgid:longint;out srdef : tdef;out srsym:tsym;out srsymtable:TSymtable):boolean;
     function  searchsym_in_class_by_msgstr(classh:tobjectdef;const s:string;out srsym:tsym;out srsymtable:TSymtable):boolean;
     function  search_system_type(const s: TIDString): ttypesym;
     function  search_named_unit_globaltype(const unitname, typename: TIDString; throwerror: boolean): ttypesym;
-    function  search_class_member(pd : tobjectdef;const s : string):tsym;
+    function  search_struct_member(pd : tabstractrecorddef;const s : string):tsym;
     function  search_assignment_operator(from_def,to_def:Tdef):Tprocdef;
     function  search_enumerator_operator(from_def,to_def:Tdef):Tprocdef;
     function  search_class_helper(pd : tobjectdef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
@@ -579,7 +580,7 @@ implementation
       begin
          if (tsym(sym).typ in [staticvarsym,localvarsym,paravarsym,fieldvarsym]) and
             ((tsym(sym).owner.symtabletype in
-             [parasymtable,localsymtable,ObjectSymtable,staticsymtable])) then
+             [parasymtable,localsymtable,ObjectSymtable,recordsymtable,staticsymtable])) then
            begin
             { unused symbol should be reported only if no }
             { error is reported                     }
@@ -602,8 +603,8 @@ implementation
                    end
                  else if (tsym(sym).owner.symtabletype=parasymtable) then
                    MessagePos1(tsym(sym).fileinfo,sym_h_para_identifier_not_used,tsym(sym).prettyname)
-                 else if (tsym(sym).owner.symtabletype=ObjectSymtable) then
-                   MessagePos2(tsym(sym).fileinfo,sym_n_private_identifier_not_used,tobjectdef(tsym(sym).owner.defowner).RttiName,tsym(sym).prettyname)
+                 else if (tsym(sym).owner.symtabletype in [ObjectSymtable,recordsymtable]) then
+                   MessagePos2(tsym(sym).fileinfo,sym_n_private_identifier_not_used,tabstractrecorddef(tsym(sym).owner.defowner).RttiName,tsym(sym).prettyname)
                  else
                    MessagePos1(tsym(sym).fileinfo,sym_n_local_identifier_not_used,tsym(sym).prettyname);
               end
@@ -615,8 +616,8 @@ implementation
                         not(vo_is_funcret in tabstractvarsym(sym).varoptions) then
                        MessagePos1(tsym(sym).fileinfo,sym_h_para_identifier_only_set,tsym(sym).prettyname)
                    end
-                 else if (tsym(sym).owner.symtabletype=ObjectSymtable) then
-                   MessagePos2(tsym(sym).fileinfo,sym_n_private_identifier_only_set,tobjectdef(tsym(sym).owner.defowner).RttiName,tsym(sym).prettyname)
+                 else if (tsym(sym).owner.symtabletype in [ObjectSymtable,recordsymtable]) then
+                   MessagePos2(tsym(sym).fileinfo,sym_n_private_identifier_only_set,tabstractrecorddef(tsym(sym).owner.defowner).RttiName,tsym(sym).prettyname)
                  else if tabstractvarsym(sym).varoptions*[vo_is_funcret,vo_is_public,vo_is_external]=[] then
                    MessagePos1(tsym(sym).fileinfo,sym_n_local_identifier_only_set,tsym(sym).prettyname);
               end
@@ -625,22 +626,22 @@ implementation
               MessagePos1(tsym(sym).fileinfo,sym_w_identifier_only_read,tsym(sym).prettyname)
           end
         else if ((tsym(sym).owner.symtabletype in
-              [ObjectSymtable,parasymtable,localsymtable,staticsymtable])) then
+              [ObjectSymtable,parasymtable,localsymtable,staticsymtable,recordsymtable])) then
           begin
            if (Errorcount<>0) or
               (sp_internal in tsym(sym).symoptions) then
              exit;
            { do not claim for inherited private fields !! }
-           if (tsym(sym).refs=0) and (tsym(sym).owner.symtabletype=ObjectSymtable) then
+           if (tsym(sym).refs=0) and (tsym(sym).owner.symtabletype in [ObjectSymtable,recordsymtable]) then
              case tsym(sym).typ of
                typesym:
-                 MessagePos2(tsym(sym).fileinfo,sym_n_private_type_not_used,tobjectdef(tsym(sym).owner.defowner).RttiName,tsym(sym).prettyname);
+                 MessagePos2(tsym(sym).fileinfo,sym_n_private_type_not_used,tabstractrecorddef(tsym(sym).owner.defowner).RttiName,tsym(sym).prettyname);
                constsym:
-                 MessagePos2(tsym(sym).fileinfo,sym_n_private_const_not_used,tobjectdef(tsym(sym).owner.defowner).RttiName,tsym(sym).prettyname);
+                 MessagePos2(tsym(sym).fileinfo,sym_n_private_const_not_used,tabstractrecorddef(tsym(sym).owner.defowner).RttiName,tsym(sym).prettyname);
                propertysym:
-                 MessagePos2(tsym(sym).fileinfo,sym_n_private_property_not_used,tobjectdef(tsym(sym).owner.defowner).RttiName,tsym(sym).prettyname);
+                 MessagePos2(tsym(sym).fileinfo,sym_n_private_property_not_used,tabstractrecorddef(tsym(sym).owner.defowner).RttiName,tsym(sym).prettyname);
              else
-               MessagePos2(tsym(sym).fileinfo,sym_n_private_method_not_used,tobjectdef(tsym(sym).owner.defowner).RttiName,tsym(sym).prettyname);
+               MessagePos2(tsym(sym).fileinfo,sym_n_private_method_not_used,tabstractrecorddef(tsym(sym).owner.defowner).RttiName,tsym(sym).prettyname);
              end
            { units references are problematic }
            else
@@ -679,9 +680,9 @@ implementation
            Don't test simple object aliases PM
          }
          if (tsym(sym).typ=typesym) and
-            (ttypesym(sym).typedef.typ=objectdef) and
+            (ttypesym(sym).typedef.typ in [objectdef,recorddef]) and
             (ttypesym(sym).typedef.typesym=tsym(sym)) then
-           tobjectdef(ttypesym(sym).typedef).symtable.SymList.ForEachCall(@TestPrivate,nil);
+           tabstractrecorddef(ttypesym(sym).typedef).symtable.SymList.ForEachCall(@TestPrivate,nil);
       end;
 
 
@@ -1046,9 +1047,9 @@ implementation
                               TRecordSymtable
 ****************************************************************************}
 
-    constructor trecordsymtable.create(usealign:shortint);
+    constructor trecordsymtable.create(const n:string;usealign:shortint);
       begin
-        inherited create('',usealign);
+        inherited create(n,usealign);
         symtabletype:=recordsymtable;
       end;
 
@@ -1187,7 +1188,7 @@ implementation
          if not(sym.typ in [procsym,propertysym]) then
            begin
               { but private ids can be reused }
-              hsym:=search_class_member(tobjectdef(defowner),hashedid.id);
+              hsym:=search_struct_member(tobjectdef(defowner),hashedid.id);
               if assigned(hsym) and
                  (
                   (
@@ -1321,13 +1322,13 @@ implementation
           as the procsym }
         if not is_funcret_sym(sym) and
            (defowner.typ=procdef) and
-           assigned(tprocdef(defowner)._class) and
-           (tprocdef(defowner).owner.defowner=tprocdef(defowner)._class) and
+           assigned(tprocdef(defowner).struct) and
+           (tprocdef(defowner).owner.defowner=tprocdef(defowner).struct) and
            (
             not(m_delphi in current_settings.modeswitches) or
-            is_object(tprocdef(defowner)._class)
+            is_object(tprocdef(defowner).struct)
            ) then
-          result:=tprocdef(defowner)._class.symtable.checkduplicate(hashedid,sym);
+          result:=tprocdef(defowner).struct.symtable.checkduplicate(hashedid,sym);
       end;
 
 
@@ -1351,13 +1352,13 @@ implementation
           exit;
         if not(m_duplicate_names in current_settings.modeswitches) and
            (defowner.typ=procdef) and
-           assigned(tprocdef(defowner)._class) and
-           (tprocdef(defowner).owner.defowner=tprocdef(defowner)._class) and
+           assigned(tprocdef(defowner).struct) and
+           (tprocdef(defowner).owner.defowner=tprocdef(defowner).struct) and
            (
             not(m_delphi in current_settings.modeswitches) or
-            is_object(tprocdef(defowner)._class)
+            is_object(tprocdef(defowner).struct)
            ) then
-          result:=tprocdef(defowner)._class.symtable.checkduplicate(hashedid,sym);
+          result:=tprocdef(defowner).struct.symtable.checkduplicate(hashedid,sym);
       end;
 
 
@@ -1603,8 +1604,8 @@ implementation
       var
         s1,s2 : string;
       begin
-        if def.typ=objectdef then
-          s1:=tobjectdef(def).RttiName
+        if def.typ in [objectdef,recorddef] then
+          s1:=tabstractrecorddef(def).RttiName
         else
           s1:=def.typename;
         { When the names are the same try to include the unit name }
@@ -1621,7 +1622,7 @@ implementation
     function generate_nested_name(symtable:tsymtable;delimiter:string):string;
       begin
         result:='';
-        while assigned(symtable) and (symtable.symtabletype=ObjectSymtable) do
+        while assigned(symtable) and (symtable.symtabletype in [ObjectSymtable,recordsymtable]) do
           begin
             if (result='') then
               result:=symtable.name^
@@ -1692,25 +1693,25 @@ implementation
        end;
 
 
-    function is_visible_for_object(symst:tsymtable;symvisibility:tvisibility;contextobjdef:tobjectdef):boolean;
+    function is_visible_for_object(symst:tsymtable;symvisibility:tvisibility;contextobjdef:tabstractrecorddef):boolean;
 
-      function is_holded_by(childdef,ownerdef: tobjectdef): boolean;
+      function is_holded_by(childdef,ownerdef: tabstractrecorddef): boolean;
         begin
           result:=childdef=ownerdef;
-          if not result and (childdef.owner.symtabletype=ObjectSymtable) then
-            result:=is_holded_by(tobjectdef(childdef.owner.defowner),ownerdef);
+          if not result and (childdef.owner.symtabletype in [ObjectSymtable,recordsymtable]) then
+            result:=is_holded_by(tabstractrecorddef(childdef.owner.defowner),ownerdef);
         end;
 
       var
-        symownerdef : tobjectdef;
+        symownerdef : tabstractrecorddef;
       begin
         result:=false;
 
         { Get objdectdef owner of the symtable for the is_related checks }
         if not assigned(symst) or
-           (symst.symtabletype<>objectsymtable) then
+           not (symst.symtabletype in [objectsymtable,recordsymtable]) then
           internalerror(200810285);
-        symownerdef:=tobjectdef(symst.defowner);
+        symownerdef:=tabstractrecorddef(symst.defowner);
         case symvisibility of
           vis_private :
             begin
@@ -1723,28 +1724,28 @@ implementation
                       ( // the case of specialize inside the generic declaration
                        (symownerdef.owner.symtabletype = objectsymtable) and
                        (
-                         assigned(current_objectdef) and
+                         assigned(current_structdef) and
                          (
-                           (current_objectdef=symownerdef) or
-                           (current_objectdef.owner.iscurrentunit)
+                           (current_structdef=symownerdef) or
+                           (current_structdef.owner.iscurrentunit)
                          )
                        ) or
                        (
-                         not assigned(current_objectdef) and
+                         not assigned(current_structdef) and
                          (symownerdef.owner.iscurrentunit)
                        )
                       );
             end;
           vis_strictprivate :
             begin
-              result:=assigned(current_objectdef) and
-                      is_holded_by(current_objectdef,symownerdef);
+              result:=assigned(current_structdef) and
+                      is_holded_by(current_structdef,symownerdef);
             end;
           vis_strictprotected :
             begin
-               result:=assigned(current_objectdef) and
-                       (current_objectdef.is_related(symownerdef) or
-                        is_holded_by(current_objectdef,symownerdef));
+               result:=assigned(current_structdef) and
+                       (current_structdef.is_related(symownerdef) or
+                        is_holded_by(current_structdef,symownerdef));
             end;
           vis_protected :
             begin
@@ -1765,14 +1766,14 @@ implementation
                        ( // the case of specialize inside the generic declaration
                         (symownerdef.owner.symtabletype = objectsymtable) and
                         (
-                          assigned(current_objectdef) and
+                          assigned(current_structdef) and
                           (
-                            (current_objectdef=symownerdef) or
-                            (current_objectdef.owner.iscurrentunit)
+                            (current_structdef=symownerdef) or
+                            (current_structdef.owner.iscurrentunit)
                           )
                         ) or
                         (
-                          not assigned(current_objectdef) and
+                          not assigned(current_structdef) and
                           (symownerdef.owner.iscurrentunit)
                          )
                        )
@@ -1785,13 +1786,13 @@ implementation
       end;
 
 
-    function is_visible_for_object(pd:tprocdef;contextobjdef:tobjectdef):boolean;
+    function is_visible_for_object(pd:tprocdef;contextobjdef:tabstractrecorddef):boolean;
       begin
         result:=is_visible_for_object(pd.owner,pd.visibility,contextobjdef);
       end;
 
 
-    function is_visible_for_object(sym:tsym;contextobjdef:tobjectdef):boolean;
+    function is_visible_for_object(sym:tsym;contextobjdef:tabstractrecorddef):boolean;
       var
         i  : longint;
         pd : tprocdef;
@@ -1819,7 +1820,7 @@ implementation
     function  searchsym(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
       var
         hashedid   : THashedIDString;
-        contextobjdef : tobjectdef;
+        contextstructdef : tabstractrecorddef;
         stackitem  : psymtablestackitem;
       begin
         result:=false;
@@ -1845,14 +1846,14 @@ implementation
                       defined in this unit }
                     if (srsymtable.symtabletype=withsymtable) and
                        assigned(srsymtable.defowner) and
-                       (srsymtable.defowner.typ=objectdef) and
+                       (srsymtable.defowner.typ in [recorddef,objectdef]) and
                        (srsymtable.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
                        (srsymtable.defowner.owner.iscurrentunit) then
-                      contextobjdef:=tobjectdef(srsymtable.defowner)
+                      contextstructdef:=tobjectdef(srsymtable.defowner)
                     else
-                      contextobjdef:=current_objectdef;
-                    if (srsym.owner.symtabletype<>objectsymtable) or
-                       is_visible_for_object(srsym,contextobjdef) then
+                      contextstructdef:=current_structdef;
+                    if not (srsym.owner.symtabletype in [objectsymtable,recordsymtable]) or
+                       is_visible_for_object(srsym,contextstructdef) then
                       begin
                         { we need to know if a procedure references symbols
                           in the static symtable, because then it can't be
@@ -1877,6 +1878,7 @@ implementation
       var
         hashedid  : THashedIDString;
         stackitem : psymtablestackitem;
+        classh : tobjectdef;
       begin
         result:=false;
         hashedid.id:=s;
@@ -1885,28 +1887,36 @@ implementation
           begin
             {
               It is not possible to have type symbols in:
-                records
                 parameters
-              Exception are classes, objects, generic definitions and specializations
+              Exception are classes, objects, records, generic definitions and specializations
               that have the parameterized types inserted in the symtable.
             }
             srsymtable:=stackitem^.symtable;
-            if not(srsymtable.symtabletype in [recordsymtable,ObjectSymtable,parasymtable]) or
-               (assigned(srsymtable.defowner) and
-                (
-                 (df_generic in tdef(srsymtable.defowner).defoptions) or
-                 (df_specialization in tdef(srsymtable.defowner).defoptions) or
-                 is_class_or_object(tdef(srsymtable.defowner)))
-                ) then
+            if (srsymtable.symtabletype=ObjectSymtable) then
               begin
+                classh:=tobjectdef(srsymtable.defowner);
+                while assigned(classh) do
+                  begin
+                    srsymtable:=classh.symtable;
                 srsym:=tsym(srsymtable.FindWithHash(hashedid));
                 if assigned(srsym) and
-                   not(srsym.typ in [fieldvarsym,paravarsym]) and
-                   (
-                    (srsym.owner.symtabletype<>objectsymtable) or
-                    (is_visible_for_object(srsym,current_objectdef) and
-                     (srsym.typ=typesym))
-                   ) then
+                       not(srsym.typ in [fieldvarsym,paravarsym,propertysym,procsym,labelsym]) and
+                       is_visible_for_object(srsym,current_structdef) then
+                  begin
+                        addsymref(srsym);
+                        result:=true;
+                        exit;
+                      end;
+                    classh:=classh.childof;
+                  end;
+              end
+            else
+            if srsymtable.symtabletype<>parasymtable then
+              begin
+                srsym:=tsym(srsymtable.FindWithHash(hashedid));
+                if assigned(srsym) and 
+                   not(srsym.typ in [fieldvarsym,paravarsym,propertysym,procsym,labelsym]) and
+                   (not (srsym.owner.symtabletype in [objectsymtable,recordsymtable]) or is_visible_for_object(srsym,current_structdef)) then
                   begin
                     { we need to know if a procedure references symbols
                       in the static symtable, because then it can't be
@@ -2113,6 +2123,22 @@ implementation
           end;
       end;
 
+    function  searchsym_in_record(recordh:tabstractrecorddef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
+      var
+        hashedid : THashedIDString;
+      begin
+        hashedid.id:=s;
+        srsymtable:=recordh.symtable;
+        srsym:=tsym(srsymtable.FindWithHash(hashedid));
+        if assigned(srsym) and is_visible_for_object(srsym,recordh) then
+          begin
+            addsymref(srsym);
+            result:=true;
+            exit;
+          end;
+        srsym:=nil;
+        srsymtable:=nil;
+      end;
 
     function searchsym_in_class_by_msgint(classh:tobjectdef;msgid:longint;out srdef : tdef;out srsym:tsym;out srsymtable:TSymtable):boolean;
       var
@@ -2411,17 +2437,17 @@ implementation
       end;
 
 
-    function search_class_member(pd : tobjectdef;const s : string):tsym;
+    function search_struct_member(pd : tabstractrecorddef;const s : string):tsym;
     { searches n in symtable of pd and all anchestors }
       var
         hashedid   : THashedIDString;
         srsym      : tsym;
-        orgpd      : tobjectdef;
+        orgpd      : tabstractrecorddef;
         srsymtable : tsymtable;
       begin
         { in case this is a formal objcclass, first find the real definition }
         if (oo_is_formal in pd.objectoptions) then
-          pd:=find_real_objcclass_definition(pd,true);
+          pd:=find_real_objcclass_definition(tobjectdef(pd),true);
         hashedid.id:=s;
         orgpd:=pd;
         while assigned(pd) do
@@ -2429,15 +2455,18 @@ implementation
            srsym:=tsym(pd.symtable.FindWithHash(hashedid));
            if assigned(srsym) then
             begin
-              search_class_member:=srsym;
+              search_struct_member:=srsym;
               exit;
             end;
-           pd:=pd.childof;
+           if pd.typ=objectdef then
+             pd:=tobjectdef(pd).childof
+           else
+             pd:=nil;
          end;
 
         { not found, now look for class helpers }
         if is_objcclass(pd) then
-          search_class_helper(orgpd,s,result,srsymtable)
+          search_class_helper(tobjectdef(orgpd),s,result,srsymtable)
         else
           result:=nil;
       end;

compiler/utils/ppudump.pp

@@ -2091,6 +2091,9 @@ begin
          ibrecorddef :
            begin
              readcommondef('Record definition',defoptions);
+             writeln(space,'   Name of Record : ',getstring);
+             write  (space,'          Options : ');
+             readobjectdefoptions;
              writeln(space,'       FieldAlign : ',getbyte);
              writeln(space,'      RecordAlign : ',getbyte);
              writeln(space,'         PadAlign : ',getbyte);
@@ -2108,6 +2111,9 @@ begin
          ibobjectdef :
            begin
              readcommondef('Object/Class definition',defoptions);
+             writeln(space,'    Name of Class : ',getstring);
+             write  (space,'          Options : ');
+             readobjectdefoptions;
              b:=getbyte;
              write  (space,'             Type : ');
              case tobjecttyp(b) of
@@ -2121,7 +2127,6 @@ begin
                odt_objcprotocol   : writeln('objcprotocol');
                else                 writeln('!! Warning: Invalid object type ',b);
              end;
-             writeln(space,'    Name of Class : ',getstring);
              writeln(space,'    External name : ',getstring);
              writeln(space,'       Import lib : ',getstring);
              writeln(space,'         DataSize : ',getaint);
@@ -2130,8 +2135,6 @@ begin
              writeln(space,'       Vmt offset : ',getlongint);
              write  (space,  '   Ancestor Class : ');
              readderef('');
-             write  (space,'          Options : ');
-             readobjectdefoptions;
 
              if tobjecttyp(b) in [odt_interfacecom,odt_interfacecorba,odt_dispinterface] then
                begin

compiler/x86_64/cgcpu.pas

@@ -148,7 +148,7 @@ unit cgcpu;
       begin
         if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
           Internalerror(200006137);
-        if not assigned(procdef._class) or
+        if not assigned(procdef.struct) or
            (procdef.procoptions*[po_classmethod, po_staticmethod,
              po_methodpointer, po_interrupt, po_iocheck]<>[]) then
           Internalerror(200006138);
@@ -180,7 +180,7 @@ unit cgcpu;
               reference_reset_base(href,NR_RDI,0,sizeof(pint));
             cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_RAX);
             { jmp *vmtoffs(%eax) ; method offs }
-            reference_reset_base(href,NR_RAX,procdef._class.vmtmethodoffset(procdef.extnumber),sizeof(pint));
+            reference_reset_base(href,NR_RAX,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint));
             list.concat(taicpu.op_ref_reg(A_MOV,S_Q,href,NR_RAX));
             list.concat(taicpu.op_reg(A_JMP,S_Q,NR_RAX));
           end

tests/test/terecs1.pp

@@ -0,0 +1,18 @@
+{ %fail}
+{ %norun}
+program terecs1;
+
+{$mode delphi}
+{$apptype console}
+
+uses
+  terecs_u1;
+
+var
+  F: TFoo;
+begin
+  // we can't access private fields
+  F.F1 := 0;
+  F.F2 := 1;
+end.
+

tests/test/terecs2.pp

@@ -0,0 +1,19 @@
+{ %fail}
+{ %norun}
+program terecs2;
+
+{$mode delphi}
+type
+  TFoo = record
+  private
+    F1: Integer;
+    F2: Byte;
+  public
+    F3: Integer;
+    F4: Byte;
+  published // record can't have published fields
+    F5: String;
+  end;
+
+begin
+end.

tests/test/terecs3.pp

@@ -0,0 +1,36 @@
+program terecs3;
+
+{$mode delphi}
+{$apptype console}
+
+uses
+  terecs_u1;
+
+var
+  F: TFoo;
+begin
+  F.F3 := 0;
+  F.F4 := 1;
+  if F.F3 <> 0 then
+    halt(1);
+  if F.F4 <> 1 then
+    halt(2);
+  if F.C <> 1 then
+    halt(3);
+  if F.Test(3) <> 4 then
+    halt(4);
+  if F.Test1(4) <> 5 then
+    halt(5);
+  if F.F5 <> 6 then
+    halt(6);
+  F.P3 := 7;
+  if F.P3 <> 7 then
+    halt(7);
+  F.P5 := 8;
+  if F.P5 <> 8 then
+    halt(8);
+  // test Self
+  F.Test2;
+  F.Test3;
+  WriteLn('ok');
+end.

tests/test/terecs4.pp

@@ -0,0 +1,17 @@
+{ %fail}
+{ %norun}
+program terecs4;
+
+{$mode delphi}
+
+type
+  TFoo = record
+    destructor Destroy; // not allowed
+  end;
+
+destructor TFoo.Destroy;
+begin
+end;
+
+begin
+end.

tests/test/terecs5.pp

@@ -0,0 +1,17 @@
+{ %fail}
+{ %norun}
+program terecs5;
+
+{$mode delphi}
+
+type
+  TFoo = record
+    class procedure Test; // not allowed without static
+  end;
+
+class procedure TFoo.Test;
+begin
+end;
+
+begin
+end.

tests/test/terecs_u1.pp

@@ -0,0 +1,95 @@
+{ %norun }
+unit terecs_u1;
+
+{$mode delphi}
+
+interface
+type
+  HWND = integer;
+  TFoo = record
+    hWnd : HWND;
+  private
+    F1: Integer;
+    F2: Byte;
+  public
+    type
+      TBar = Integer;
+    const
+      C: TBar = 1;
+    var
+      F3: TBar;
+      F4: Byte;
+    class var
+      F5: TBar;
+    function Test(n: TBar): TBar;
+    class function Test1(n: TBar): TBar; static;
+
+    procedure Set3(const Value: TBar);
+    class procedure Set5(const Value: TBar); static;
+
+    property P3: TBar read F3 write Set3;
+    class property P5: TBar read F5 write Set5;
+
+    class constructor Create;
+    class destructor Destroy;
+
+    procedure Test2;
+    procedure Test3;
+  end;
+
+procedure Test4(AFoo: TFoo);
+
+implementation
+
+function TFoo.Test(n: TBar): TBar;
+begin
+  Result := F3 + F4 + n;
+end;
+
+class function TFoo.Test1(n: TBar): TBar;
+begin
+  Result := C + n;
+end;
+
+class constructor TFoo.Create;
+begin
+  F5 := 6;
+end;
+
+class destructor TFoo.Destroy;
+begin
+  WriteLn('TFoo.Destroy');
+end;
+
+procedure TFoo.Set3(const Value: TBar);
+begin
+  F3 := Value;
+end;
+
+class procedure TFoo.Set5(const Value: TBar); static;
+begin
+  F5 := Value;
+end;
+
+procedure TFoo.Test2;
+begin
+  if Self.C <> 1 then
+    halt(50);
+  if Self.F3 <> 7 then
+    halt(51);
+end;
+
+procedure TFoo.Test3;
+begin
+  Test4(Self);
+end;
+
+procedure Test4(AFoo: TFoo);
+begin
+  if AFoo.C <> 1 then
+    halt(100);
+  if AFoo.P3 <> 7 then
+    halt(101);
+end;
+
+end.