Browse Source

compiler: call gen_intf_wrappers not only for unit symtables but also for syntables of records and object types because they can contain nested classes (bug #0018610)

git-svn-id: trunk@16818 -
paul 14 years ago
parent
commit
0f35da07f1
4 changed files with 38 additions and 7 deletions
  1. 1 0
      .gitattributes
  2. 9 4
      compiler/ncgutil.pas
  3. 3 3
      compiler/pmodules.pas
  4. 25 0
      tests/webtbs/tw18610.pp

+ 1 - 0
.gitattributes

@@ -10959,6 +10959,7 @@ tests/webtbs/tw1851.pp svneol=native#text/plain
 tests/webtbs/tw18512.pp svneol=native#text/pascal
 tests/webtbs/tw18512.pp svneol=native#text/pascal
 tests/webtbs/tw1856.pp svneol=native#text/plain
 tests/webtbs/tw1856.pp svneol=native#text/plain
 tests/webtbs/tw18567 svneol=native#text/pascal
 tests/webtbs/tw18567 svneol=native#text/pascal
+tests/webtbs/tw18610.pp svneol=native#text/pascal
 tests/webtbs/tw1862.pp svneol=native#text/plain
 tests/webtbs/tw1862.pp svneol=native#text/plain
 tests/webtbs/tw1863.pp svneol=native#text/plain
 tests/webtbs/tw1863.pp svneol=native#text/plain
 tests/webtbs/tw1867.pp svneol=native#text/plain
 tests/webtbs/tw1867.pp svneol=native#text/plain

+ 9 - 4
compiler/ncgutil.pas

@@ -101,7 +101,7 @@ interface
     procedure gen_load_return_value(list:TAsmList);
     procedure gen_load_return_value(list:TAsmList);
 
 
     procedure gen_external_stub(list:TAsmList;pd:tprocdef;const externalname:string);
     procedure gen_external_stub(list:TAsmList;pd:tprocdef;const externalname:string);
-    procedure gen_intf_wrappers(list:TAsmList;st:TSymtable);
+    procedure gen_intf_wrappers(list:TAsmList;st:TSymtable;nested:boolean);
     procedure gen_load_vmt_register(list:TAsmList;objdef:tobjectdef;selfloc:tlocation;var vmtreg:tregister);
     procedure gen_load_vmt_register(list:TAsmList;objdef:tobjectdef;selfloc:tlocation;var vmtreg:tregister);
 
 
     procedure get_used_regvars(n: tnode; var rv: tusedregvars);
     procedure get_used_regvars(n: tnode; var rv: tusedregvars);
@@ -2963,19 +2963,24 @@ implementation
       end;
       end;
 
 
 
 
-    procedure gen_intf_wrappers(list:TAsmList;st:TSymtable);
+    procedure gen_intf_wrappers(list:TAsmList;st:TSymtable;nested:boolean);
       var
       var
         i   : longint;
         i   : longint;
         def : tdef;
         def : tdef;
       begin
       begin
-        create_codegen;
+        if not nested then
+          create_codegen;
         for i:=0 to st.DefList.Count-1 do
         for i:=0 to st.DefList.Count-1 do
           begin
           begin
             def:=tdef(st.DefList[i]);
             def:=tdef(st.DefList[i]);
+            { if def can contain nested types then handle it symtable }
+            if def.typ in [objectdef,recorddef] then
+              gen_intf_wrappers(list,tabstractrecorddef(def).symtable,true);
             if is_class(def) then
             if is_class(def) then
               gen_intf_wrapper(list,tobjectdef(def));
               gen_intf_wrapper(list,tobjectdef(def));
           end;
           end;
-        destroy_codegen;
+        if not nested then
+          destroy_codegen;
       end;
       end;
 
 
 
 

+ 3 - 3
compiler/pmodules.pas

@@ -1360,8 +1360,8 @@ implementation
          maybeloadvariantsunit;
          maybeloadvariantsunit;
 
 
          { generate wrappers for interfaces }
          { generate wrappers for interfaces }
-         gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.globalsymtable);
-         gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.localsymtable);
+         gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.globalsymtable,false);
+         gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.localsymtable,false);
 
 
          { generate pic helpers to load eip if necessary }
          { generate pic helpers to load eip if necessary }
          gen_pic_helpers(current_asmdata.asmlists[al_procedures]);
          gen_pic_helpers(current_asmdata.asmlists[al_procedures]);
@@ -2333,7 +2333,7 @@ implementation
          MaybeGenerateObjectiveCImageInfo(nil,current_module.localsymtable);
          MaybeGenerateObjectiveCImageInfo(nil,current_module.localsymtable);
 
 
          { generate wrappers for interfaces }
          { generate wrappers for interfaces }
-         gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.localsymtable);
+         gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.localsymtable,false);
 
 
          { generate imports }
          { generate imports }
          if current_module.ImportLibraryList.Count>0 then
          if current_module.ImportLibraryList.Count>0 then

+ 25 - 0
tests/webtbs/tw18610.pp

@@ -0,0 +1,25 @@
+program tw18610;
+
+{$mode delphi}{$H+}
+
+type
+  IInt = interface
+    procedure Test;
+  end;
+
+  TParent = class
+  private
+    type
+      TChild = class(TInterfacedObject, IInt)
+      public
+        procedure Test;
+      end;
+  end;
+
+procedure TParent.TChild.Test;
+begin
+end;
+
+
+begin
+end.