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

git-svn-id: branches/paul/extended_records@16544 -

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
+# 03299 is the last used one
 #
 % \section{Parser messages}
 % This section lists all parser messages. The parser takes care of the
@@ -1342,8 +1342,10 @@ parser_f_no_generic_inside_generic=03297_F_Declaration of generic class inside a
 % Since generics are implemented by recording tokens, it is not possible to
 % have declaration of generic class inside another generic class.
 % \end{description}
-parser_e_no_record_published=03298_E_Record types cannot have published sections.
-% Published sections can be used only inside classes
+parser_e_no_record_published=03298_E_Record types cannot have published sections
+% Published sections can be used only inside classes.
+parser_e_no_destructor_in_records=03299_E_Destructors aren't allowed in records
+% Destructor declarations aren't allowed in records.
 #
 # Type Checking
 #

compiler/msgidx.inc

@@ -387,6 +387,7 @@ const
   parser_e_no_procvarnested_const=03296;
   parser_f_no_generic_inside_generic=03297;
   parser_e_no_record_published=03298;
+  parser_e_no_destructor_in_records=03299;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -872,9 +873,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 57958;
+  MsgTxtSize = 58003;
 
   MsgIdxMax : array[1..20] of longint=(
-    24,88,299,97,82,54,111,22,202,63,
+    24,88,300,97,82,54,111,22,202,63,
     49,20,1,1,1,1,1,1,1,1
   );

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/ptype.pas

@@ -573,7 +573,6 @@ implementation
 
       var
         pd : tprocdef;
-        has_destructor,
         oldparse_only: boolean;
         member_blocktype : tblock_type;
         fields_allowed, is_classdef, classfields: boolean;
@@ -585,7 +584,6 @@ implementation
 
         current_structdef.symtable.currentvisibility:=vis_public;
         testcurobject:=1;
-        has_destructor:=false;
         fields_allowed:=true;
         is_classdef:=false;
         classfields:=false;
@@ -617,6 +615,7 @@ implementation
                     begin
                        consume(_PRIVATE);
                        current_structdef.symtable.currentvisibility:=vis_private;
+                       include(current_structdef.objectoptions,oo_has_private);
                        fields_allowed:=true;
                        is_classdef:=false;
                        classfields:=false;
@@ -626,6 +625,7 @@ implementation
                      begin
                        consume(_PROTECTED);
                        current_structdef.symtable.currentvisibility:=vis_protected;
+                       include(current_structdef.objectoptions,oo_has_protected);
                        fields_allowed:=true;
                        is_classdef:=false;
                        classfields:=false;
@@ -660,11 +660,13 @@ implementation
                                 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);
@@ -742,43 +744,31 @@ implementation
                 fields_allowed:=false;
                 is_classdef:=false;
               end;
-{ todo: constructor
             _CONSTRUCTOR :
               begin
-                if (current_objectdef.symtable.currentvisibility=vis_published) and
-                  not(oo_can_have_published in current_objectdef.objectoptions) then
-                  Message(parser_e_cant_have_published);
-
-                if not is_classdef and not(current_objectdef.symtable.currentvisibility in [vis_public,vis_published]) then
+                if not is_classdef and (current_structdef.symtable.currentvisibility <> vis_public) then
                   Message(parser_w_constructor_should_be_public);
 
-                if is_interface(current_objectdef) then
-                  Message(parser_e_no_con_des_in_interfaces);
-
-                { Objective-C does not know the concept of a constructor }
-                if is_objc_class_or_protocol(current_objectdef) then
-                  Message(parser_e_objc_no_constructor_destructor);
-
                 { only 1 class constructor is allowed }
-                if is_classdef and (oo_has_class_constructor in current_objectdef.objectoptions) then
-                  Message1(parser_e_only_one_class_constructor_allowed, current_objectdef.objrealname^);
+                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_object_proc_directives(pd);
+                  begin
+                    pd:=constructor_head;
+                    { raise internal error for now - constructor is not implemented yet }
+                    internalerror(201012110);
+                  end;
+                parse_record_proc_directives(pd);
                 handle_calling_convention(pd);
 
                 { add definition to procsym }
                 proc_add_definition(pd);
 
-                { add procdef options to objectdef options }
-                if (po_virtualmethod in pd.procoptions) then
-                  include(current_objectdef.objectoptions,oo_has_virtual);
-                chkcpp(pd);
                 maybe_parse_hint_directives(pd);
 
                 parse_only:=oldparse_only;
@@ -787,29 +777,12 @@ implementation
               end;
             _DESTRUCTOR :
               begin
-                if (current_objectdef.symtable.currentvisibility=vis_published) and
-                   not(oo_can_have_published in current_objectdef.objectoptions) then
-                  Message(parser_e_cant_have_published);
-
                 if not is_classdef then
-                  if has_destructor then
-                    Message(parser_n_only_one_destructor)
-                  else
-                    has_destructor:=true;
-
-                if is_interface(current_objectdef) then
-                  Message(parser_e_no_con_des_in_interfaces);
-
-                if not is_classdef and (current_objectdef.symtable.currentvisibility<>vis_public) then
-                  Message(parser_w_destructor_should_be_public);
-
-                { Objective-C does not know the concept of a destructor }
-                if is_objc_class_or_protocol(current_objectdef) then
-                  Message(parser_e_objc_no_constructor_destructor);
+                  Message(parser_e_no_destructor_in_records);
 
                 { only 1 class destructor is allowed }
-                if is_classdef and (oo_has_class_destructor in current_objectdef.objectoptions) then
-                  Message1(parser_e_only_one_class_destructor_allowed, current_objectdef.objrealname^);
+                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;
@@ -817,24 +790,18 @@ implementation
                   pd:=class_destructor_head
                 else
                   pd:=destructor_head;
-                parse_object_proc_directives(pd);
+                parse_record_proc_directives(pd);
                 handle_calling_convention(pd);
 
                 { add definition to procsym }
                 proc_add_definition(pd);
 
-                { add procdef options to objectdef options }
-                if (po_virtualmethod in pd.procoptions) then
-                  include(current_objectdef.objectoptions,oo_has_virtual);
-
-                chkcpp(pd);
                 maybe_parse_hint_directives(pd);
 
                 parse_only:=oldparse_only;
                 fields_allowed:=false;
                 is_classdef:=false;
               end;
-}
             _END :
               begin
                 consume(_END);

compiler/symdef.pas

@@ -168,6 +168,7 @@ interface
           function  GetTypeName:string;override;
        end;
 
+       tprocdef = class;
        { tabstractrecorddef }
 
        tabstractrecorddef= class(tstoreddef)
@@ -181,6 +182,7 @@ interface
           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;
@@ -204,7 +206,6 @@ interface
           function  needs_inittable : boolean;override;
        end;
 
-       tprocdef = class;
        tobjectdef = class;
 
        { TImplementedInterface }
@@ -306,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 }
@@ -2589,6 +2589,24 @@ implementation
         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
@@ -4528,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;