* move rtti and vmt table generation into write_persistent_type_info

  * call write_persistent_type_info also for typed consts in interface

git-svn-id: trunk@5239 -

compiler/pdecl.pas

@@ -57,9 +57,9 @@ implementation
        { symtable }
        symconst,symbase,symtype,symdef,symtable,paramgr,defutil,
        { pass 1 }
-       nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,nobj,
+       nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
        { codegen }
-       ncgutil,ncgrtti,
+       ncgutil,
        { parser }
        scanner,
        pbase,pexpr,ptype,ptconst,pdecsub,pdecvar,pdecobj,
@@ -230,6 +230,8 @@ implementation
                       { add default calling convention }
                       handle_calling_convention(tabstractprocdef(hdef));
                     end;
+                   { write rtti/init tables }
+                   write_persistent_type_info(hdef);
                    if not skipequal then
                     begin
                       { get init value }
@@ -396,7 +398,6 @@ implementation
          oldfilepos,
          defpos,storetokenpos : tfileposinfo;
          old_block_type : tblock_type;
-         ch       : tclassheader;
          isgeneric,
          isunique,
          istyperenaming : boolean;
@@ -559,47 +560,7 @@ implementation
               { file position }
               oldfilepos:=current_filepos;
               current_filepos:=newtype.fileinfo;
-
-              { generate persistent init/final tables when it's declared in the interface so it can
-                be reused in other used }
-              if current_module.in_interface {or
-                 (
-                  (is_class(hdef) and
-                  tobjectdef(hdef).members_need_inittable) or
-                  hdef.needs_inittable
-                 ) }
-                 then
-                RTTIWriter.write_rtti(hdef,initrtti);
-
-              { for objects we should write the vmt and interfaces.
-                This need to be done after the rtti has been written, because
-                it can contain a reference to that data (PFV)
-                This is not for forward classes }
-              if (hdef.typ=objectdef) then
-                begin
-                  if not(oo_is_forward in tobjectdef(hdef).objectoptions) then
-                    begin
-                      ch:=tclassheader.create(tobjectdef(hdef));
-                      { generate and check virtual methods, must be done
-                        before RTTI is written }
-                      ch.genvmt;
-                      { Generate RTTI for class }
-                      RTTIWriter.write_rtti(hdef,fullrtti);
-                      if is_interface(tobjectdef(hdef)) then
-                        ch.writeinterfaceids;
-                      if (oo_has_vmt in tobjectdef(hdef).objectoptions) then
-                        ch.writevmt;
-                      ch.free;
-                    end;
-                end
-              else
-                begin
-                  { Always generate RTTI info for all types. This is to have typeinfo() return
-                    the same pointer }
-                  if current_module.in_interface then
-                    RTTIWriter.write_rtti(hdef,fullrtti);
-                end;
-
+              write_persistent_type_info(hdef);
               current_filepos:=oldfilepos;
             end;
          until token<>_ID;

compiler/ptype.pas

@@ -37,17 +37,20 @@ interface
        { object type as function argument type  }
        testcurobject : byte;
 
-    { reads a string, file type or a type id and returns a name and }
-    { tdef }
+    { reads a type identifier }
+    procedure id_type(var def : tdef;isforwarddef:boolean);
+
+    { reads a string, file type or a type identifier }
     procedure single_type(var def:tdef;isforwarddef:boolean);
 
+    { reads any type declaration, where the resulting type will get name as type identifier }
     procedure read_named_type(var def:tdef;const name : TIDString;genericdef:tstoreddef;genericlist:TFPObjectList;parseprocvardir:boolean);
+
+    { reads any type declaration }
     procedure read_anon_type(var def : tdef;parseprocvardir:boolean);
 
-    { reads a type definition }
-    { to a appropriating tdef, s gets the name of   }
-    { the type to allow name mangling          }
-    procedure id_type(var def : tdef;isforwarddef:boolean);
+    { generate persistent type information like VMT, RTTI and inittables }
+    procedure write_persistent_type_info(def : tdef);
 
 
 implementation
@@ -64,7 +67,7 @@ implementation
        symconst,symbase,symsym,symtable,
        defutil,defcmp,
        { pass 1 }
-       node,
+       node,ncgrtti,nobj,
        nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
        { parser }
        scanner,
@@ -757,6 +760,7 @@ implementation
             else
               expr_type;
          end;
+
          if def=nil then
           def:=generrordef;
       end;
@@ -768,4 +772,45 @@ implementation
       end;
 
 
+    procedure write_persistent_type_info(def : tdef);
+      var
+        ch  : tclassheader;
+      begin
+        { generate persistent init/final tables when it's declared in the interface so it can
+          be reused in other used }
+        if def.owner.symtabletype=globalsymtable then
+          RTTIWriter.write_rtti(def,initrtti);
+
+        { for objects we should write the vmt and interfaces.
+          This need to be done after the rtti has been written, because
+          it can contain a reference to that data (PFV)
+          This is not for forward classes }
+        if (def.typ=objectdef) then
+          begin
+            if not(oo_vmt_written in tobjectdef(def).objectoptions) and
+               not(oo_is_forward in tobjectdef(def).objectoptions) then
+              begin
+                ch:=tclassheader.create(tobjectdef(def));
+                { generate and check virtual methods, must be done
+                  before RTTI is written }
+                ch.genvmt;
+                { Generate RTTI for class }
+                RTTIWriter.write_rtti(def,fullrtti);
+                if is_interface(tobjectdef(def)) then
+                  ch.writeinterfaceids;
+                if (oo_has_vmt in tobjectdef(def).objectoptions) then
+                  ch.writevmt;
+                ch.free;
+                include(tobjectdef(def).objectoptions,oo_vmt_written);
+              end;
+          end
+        else
+          begin
+            { Always generate RTTI info for all types. This is to have typeinfo() return
+              the same pointer }
+            if def.owner.symtabletype=globalsymtable then
+              RTTIWriter.write_rtti(def,fullrtti);
+          end;
+      end;
+
 end.

compiler/symconst.pas

@@ -305,7 +305,8 @@ type
     oo_has_msgstr,
     oo_has_msgint,
     oo_can_have_published,{ the class has rtti, i.e. you can publish properties }
-    oo_has_default_property
+    oo_has_default_property,
+    oo_vmt_written
   );
   tobjectoptions=set of tobjectoption;