paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 11:29:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

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)

Browse Source 
git-svn-id: trunk@16818 -
This commit is contained in:
paul 2011-01-26 13:50:36 +00:00
parent 6bad2fa169
commit 0f35da07f1
4 changed files with 38 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -10959,6 +10959,7 @@ tests/webtbs/tw1851.pp svneol=native#text/plain
tests/webtbs/tw18512.pp svneol=native#text/pascal
tests/webtbs/tw1856.pp svneol=native#text/plain
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/tw1863.pp svneol=native#text/plain
tests/webtbs/tw1867.pp svneol=native#text/plain

13
compiler/ncgutil.pas
View File

@ -101,7 +101,7 @@ interface
procedure gen_load_return_value(list:TAsmList);
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 get_used_regvars(n: tnode; var rv: tusedregvars);
@ -2963,19 +2963,24 @@ implementation
end;
procedure gen_intf_wrappers(list:TAsmList;st:TSymtable);
procedure gen_intf_wrappers(list:TAsmList;st:TSymtable;nested:boolean);
var
i : longint;
def : tdef;
begin
create_codegen;
if not nested then
create_codegen;
for i:=0 to st.DefList.Count-1 do
begin
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
gen_intf_wrapper(list,tobjectdef(def));
end;
destroy_codegen;
if not nested then
destroy_codegen;
end;

6
compiler/pmodules.pas
View File

@ -1360,8 +1360,8 @@ implementation
maybeloadvariantsunit;
{ 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 }
gen_pic_helpers(current_asmdata.asmlists[al_procedures]);
@ -2333,7 +2333,7 @@ implementation
MaybeGenerateObjectiveCImageInfo(nil,current_module.localsymtable);
{ 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 }
if current_module.ImportLibraryList.Count>0 then

25
tests/webtbs/tw18610.pp Normal file
View File

@ -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.