compiler: write INIT and RTTI info also for defs of nested records and classes + test (issue #0020909)

git-svn-id: trunk@20162 -

.gitattributes

@@ -12163,6 +12163,7 @@ tests/webtbs/tw20873.pp svneol=native#text/plain
 tests/webtbs/tw20874a.pp svneol=native#text/pascal
 tests/webtbs/tw20874b.pp svneol=native#text/pascal
 tests/webtbs/tw20889.pp svneol=native#text/pascal
+tests/webtbs/tw20909.pp svneol=native#text/pascal
 tests/webtbs/tw20962.pp svneol=native#text/plain
 tests/webtbs/tw20995a.pp svneol=native#text/pascal
 tests/webtbs/tw20995b.pp svneol=native#text/pascal
@@ -12986,6 +12987,8 @@ tests/webtbs/uw19701.pas svneol=native#text/plain
 tests/webtbs/uw19851.pp svneol=native#text/pascal
 tests/webtbs/uw2004.inc svneol=native#text/plain
 tests/webtbs/uw2040.pp svneol=native#text/plain
+tests/webtbs/uw20909a.pas svneol=native#text/pascal
+tests/webtbs/uw20909b.pas svneol=native#text/pascal
 tests/webtbs/uw2266a.inc svneol=native#text/plain
 tests/webtbs/uw2266b.pas svneol=native#text/plain
 tests/webtbs/uw2269.inc svneol=native#text/plain

compiler/pmodules.pas

@@ -1398,8 +1398,8 @@ implementation
          gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.localsymtable,false);
 
          { generate rtti/init tables }
-         write_persistent_type_info(current_module.globalsymtable);
-         write_persistent_type_info(current_module.localsymtable);
+         write_persistent_type_info(current_module.globalsymtable,true);
+         write_persistent_type_info(current_module.localsymtable,false);
 
          { Tables }
          InsertThreadvars;
@@ -2395,7 +2395,7 @@ implementation
          InsertThreadvars;
 
          { generate rtti/init tables }
-         write_persistent_type_info(current_module.localsymtable);
+         write_persistent_type_info(current_module.localsymtable,false);
 
          { if an Objective-C module, generate rtti and module info }
          MaybeGenerateObjectiveCImageInfo(nil,current_module.localsymtable);

compiler/ptype.pas

@@ -50,7 +50,7 @@ interface
     procedure read_anon_type(var def : tdef;parseprocvardir:boolean);
 
     { generate persistent type information like VMT, RTTI and inittables }
-    procedure write_persistent_type_info(st:tsymtable);
+    procedure write_persistent_type_info(st:tsymtable;is_global:boolean);
 
 implementation
 
@@ -1552,7 +1552,7 @@ implementation
       end;
 
 
-    procedure write_persistent_type_info(st:tsymtable);
+    procedure write_persistent_type_info(st:tsymtable;is_global:boolean);
       var
         i : longint;
         def : tdef;
@@ -1563,14 +1563,14 @@ implementation
             def:=tdef(st.DefList[i]);
             case def.typ of
               recorddef :
-                write_persistent_type_info(trecorddef(def).symtable);
+                write_persistent_type_info(trecorddef(def).symtable,is_global);
               objectdef :
                 begin
                   { Skip generics and forward defs }
                   if (df_generic in def.defoptions) or
                      (oo_is_forward in tobjectdef(def).objectoptions) then
                     continue;
-                  write_persistent_type_info(tobjectdef(def).symtable);
+                  write_persistent_type_info(tobjectdef(def).symtable,is_global);
                   { Write also VMT if not done yet }
                   if not(ds_vmt_written in def.defstates) then
                     begin
@@ -1587,9 +1587,9 @@ implementation
                 begin
                   if assigned(tprocdef(def).localst) and
                      (tprocdef(def).localst.symtabletype=localsymtable) then
-                    write_persistent_type_info(tprocdef(def).localst);
+                    write_persistent_type_info(tprocdef(def).localst,false);
                   if assigned(tprocdef(def).parast) then
-                    write_persistent_type_info(tprocdef(def).parast);
+                    write_persistent_type_info(tprocdef(def).parast,false);
                 end;
             end;
             { generate always persistent tables for types in the interface so it can
@@ -1597,7 +1597,7 @@ implementation
             { Init }
             if (
                 assigned(def.typesym) and
-                (st.symtabletype=globalsymtable) and
+                is_global and
                 not is_objc_class_or_protocol(def)
                ) or
                is_managed_type(def) or
@@ -1606,7 +1606,7 @@ implementation
             { RTTI }
             if (
                 assigned(def.typesym) and
-                (st.symtabletype=globalsymtable) and
+                is_global and
                 not is_objc_class_or_protocol(def)
                ) or
                (ds_rtti_table_used in def.defstates) then

tests/webtbs/tw20909.pp

@@ -0,0 +1,11 @@
+{%norun}
+program tw20909;
+
+{$mode objfpc}{$H+}
+
+uses
+  uw20909a, uw20909b;
+
+begin
+end.
+

tests/webtbs/uw20909a.pas

@@ -0,0 +1,26 @@
+unit uw20909a;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, uw20909b;
+
+type
+
+  TMyEvent = procedure(var Items: Storage.Folders.TItem) of object;
+
+  TMyClass = class
+  private
+    FOnChange: uw20909b.Storage.Folders.TItemsEvent;
+    FMyEvent: TMyEvent;
+  public
+    property OnChange: Storage.Folders.TItemsEvent read FOnChange write FOnChange;
+    property MyEvent: TMyEvent read FMyEvent write FMyEvent;
+  end;
+
+implementation
+
+end.
+

tests/webtbs/uw20909b.pas

@@ -0,0 +1,35 @@
+unit uw20909b;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils;
+
+type
+  Storage = class
+  public
+    type
+      Folders = class
+      public
+        const
+          FLAG_REFRESH = 1;
+          FLAG_DELETE = 2;
+        type
+          TItem = record
+            ID: int64;
+            Path: string;
+          end;
+          PItem = ^TItem;
+          TItems = array of PItem;
+          PItems = ^TItems;
+
+          TItemsEvent = procedure(var Items: TItems) of object;
+      end;
+  end;
+
+implementation
+
+end.
+