paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-03 01:09:40 +01:00
Code Issues Packages Projects Releases Wiki Activity

* write vmt always according to the order of definitions

Browse Source 
* remove obsolete lastvtableindex

git-svn-id: trunk@5811 -
This commit is contained in:
peter 2007-01-04 22:39:12 +00:00
parent 2ddeca21e6
commit 56379c37a9
6 changed files with 65 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -7942,6 +7942,7 @@ tests/webtbs/tw7847.pp svneol=native#text/plain
tests/webtbs/tw7963.pp svneol=native#text/plain
tests/webtbs/tw7975.pp svneol=native#text/plain
tests/webtbs/tw7975a.pp svneol=native#text/plain
tests/webtbs/tw8018.pp svneol=native#text/plain
tests/webtbs/tw8028.pp svneol=native#text/plain
tests/webtbs/ub1873.pp svneol=native#text/plain
tests/webtbs/ub1883.pp svneol=native#text/plain

33
compiler/nobj.pas
View File

@ -416,34 +416,31 @@ implementation
procedure TVMTBuilder.add_vmt_entries(objdef:tobjectdef);
var
def : tdef;
pd : tprocdef;
i,j : longint;
sym : tsym;
i : longint;
VMTSymEntry : TVMTSymEntry;
begin
{ start with the base class }
if assigned(objdef.childof) then
add_vmt_entries(objdef.childof);
{ process all procsyms }
for i:=0 to objdef.symtable.SymList.Count-1 do
{ process all procdefs, we must process the defs to
keep the same order as that is written in the source
to be compatible with the indexes in the interface vtable (PFV) }
for i:=0 to objdef.symtable.DefList.Count-1 do
begin
sym:=tsym(objdef.symtable.SymList[i]);
if sym.typ=procsym then
def:=tdef(objdef.symtable.DefList[i]);
if assigned(def) and
(def.typ=procdef) then
begin
pd:=tprocdef(def);
{ Find VMT procsym }
VMTSymEntry:=TVMTSymEntry(VMTSymEntryList.Find(sym.name));
VMTSymEntry:=TVMTSymEntry(VMTSymEntryList.Find(pd.procsym.name));
if not assigned(VMTSymEntry) then
VMTSymEntry:=TVMTSymEntry.Create(VMTSymEntryList,sym.name);
{ Add all procdefs }
for j:=0 to Tprocsym(sym).ProcdefList.Count-1 do
begin
pd:=tprocdef(Tprocsym(sym).ProcdefList[j]);
if pd.procsym=tprocsym(sym) then
begin
if is_new_vmt_entry(VMTSymEntry,pd) then
add_new_vmt_entry(VMTSymEntry,pd);
end;
end;
VMTSymEntry:=TVMTSymEntry.Create(VMTSymEntryList,pd.procsym.name);
{ VMT entry }
if is_new_vmt_entry(VMTSymEntry,pd) then
add_new_vmt_entry(VMTSymEntry,pd);
end;
end;
end;

2
compiler/pdecobj.pas
View File

@ -179,8 +179,6 @@ implementation
if assigned(def) and
(def.typ=procdef) then
begin
// tprocdef(def).extnumber:=aktobjectdef.lastvtableindex;
// inc(aktobjectdef.lastvtableindex);
include(tprocdef(def).procoptions,po_virtualmethod);
tprocdef(def).forwarddef:=false;
end;

2
compiler/ppu.pas
View File

@ -43,7 +43,7 @@ type
{$endif Test_Double_checksum}
const
CurrentPPUVersion=71;
CurrentPPUVersion=72;
{ buffer sizes }
maxentrysize = 1024;

9
compiler/symdef.pas
View File

@ -235,7 +235,6 @@ interface
iidstr : pshortstring;
iitype : tinterfaceentrytype;
iioffset : longint;
lastvtableindex: longint;
{ store implemented interfaces defs and name mappings }
ImplementedInterfaces : TFPObjectList;
constructor create(ot : tobjecttyp;const n : string;c : tobjectdef);
@ -3579,7 +3578,6 @@ implementation
{ create space for vmt !! }
vmtentries:=nil;
vmt_offset:=0;
lastvtableindex:=0;
set_parent(c);
objname:=stringdup(upper(n));
objrealname:=stringdup(n);
@ -3622,7 +3620,6 @@ implementation
new(iidguid);
ppufile.getguid(iidguid^);
iidstr:=stringdup(ppufile.getstring);
lastvtableindex:=ppufile.getlongint;
end;
{ load implemented interfaces }
@ -3705,7 +3702,6 @@ implementation
end;
if assigned(iidstr) then
tobjectdef(result).iidstr:=stringdup(iidstr^);
tobjectdef(result).lastvtableindex:=lastvtableindex;
if assigned(ImplementedInterfaces) then
begin
for i:=0 to ImplementedInterfaces.count-1 do
@ -3737,7 +3733,6 @@ implementation
begin
ppufile.putguid(iidguid^);
ppufile.putstring(iidstr^);
ppufile.putlongint(lastvtableindex);
end;
if objecttype in [odt_class,odt_interfacecorba] then
@ -3837,9 +3832,7 @@ implementation
if assigned(c) then
begin
{ only important for classes }
lastvtableindex:=c.lastvtableindex;
objectoptions:=objectoptions+(c.objectoptions*
inherited_objectoptions);
objectoptions:=objectoptions+(c.objectoptions*inherited_objectoptions);
if not (objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface]) then
begin
{ add the data of the anchestor class }

47
tests/webtbs/tw8018.pp Executable file
View File

@ -0,0 +1,47 @@
{$mode delphi}
type
itest = interface(iunknown)
procedure Foo(); overload;
procedure Bar(); overload;
procedure Foo(x: integer); overload;
procedure Bar(x: integer); overload;
end;
ttest = class(tinterfacedobject, itest)
procedure Foo(); overload;
procedure Bar(); overload;
procedure Foo(x: integer); overload;
procedure Bar(x: integer); overload;
end;
var
i : integer;
err : boolean;
procedure ttest.Foo(); overload; begin writeln('#'); i:=1; end;
procedure ttest.Foo(x: integer); overload; begin writeln('##'); i:=2; end;
procedure ttest.Bar(); overload; begin writeln('###'); i:=3; end;
procedure ttest.Bar(x: integer); overload; begin writeln('####'); i:=4; end;
var
t: itest;
a: integer;
begin
t := ttest.create();
t.Foo();
if i<>1 then
err:=true;
t.Foo(a);
if i<>2 then
err:=true;
t.Bar();
if i<>3 then
err:=true;
t.Bar(a);
if i<>4 then
err:=true;
t := nil;
if err then
halt(1);
end.